@matheusbsbs / matheus-bagliano / commits / 6d5ed4836d

git{,-blame}.el: remove old bitrotting Emacs code

The git-blame.el mode has been superseded by Emacs's own vc-annotate (invoked by C-x v g). Users of the git.el mode are now much better off using either Magit or the Git backend for Emacs's own VC mode. These modes were added over 10 years ago when Emacs's own Git support was much less mature, and there weren't other mature modes in the wild or shipped with Emacs itself. These days these modes have few if any users, and users of git aren't well served by us shipping these (some OS's install them alongside git by default, which is confusing and leads users astray). So let's remove these per Alexandre Julliard's message to the ML[1]. If someone still wants these for some reason they're better served by hosting these elsewhere (e.g. on ELPA), instead of us distributing them with git. However, since downstream packagers such as Debian are packaging this as git-el it's less disruptive to still carry these files as Elisp code that'll error out with a message suggesting alternatives, rather than drop the files entirely[2]. Then rather than receive a cryptic load error when they upgrade existing users will get an error directing them to the README file, or to just stop requiring these modes. I think it makes sense to link to GitHub's hosting of contrib/emacs/README (which'll be updated by the time users see this) so they don't have to hunt down the packaged README on their local system. 1. "Re: [PATCH] git.el: handle default excludesfile properly" (87muzlwhb0.fsf@winehq.org) -- https://public-inbox.org/git/87muzlwhb0.fsf@winehq.org/ 2. "Re: [PATCH v3] git{,-blame}.el: remove old bitrotting Emacs code" (20180327165751.GA4343@aiede.svl.corp.google.com) -- https://public-inbox.org/git/20180327165751.GA4343@aiede.svl.corp.google.com/ Signed-off-by: Ævar Arnfjörð Bjarmason <avarab@gmail.com> Signed-off-by: Junio C Hamano <gitster@pobox.com>

Ævar Arnfjörð Bjarmason committed Apr 11, 2018 at 20:42 UTC 6d5ed4836db94c07498e34ddebc31abbe532c8e1

5 files changed +25 -2228

contrib/emacs/.gitignore deleted

-1

@@ -1 +0,0 @@

1 -*.elc

contrib/emacs/Makefile deleted

-21

@@ -1,21 +0,0 @@

1 -## Build and install stuff

2 -

3 -EMACS = emacs

4 -

5 -ELC = git.elc git-blame.elc

6 -INSTALL ?= install

7 -INSTALL_ELC = $(INSTALL) -m 644

8 -prefix ?= $(HOME)

9 -emacsdir = $(prefix)/share/emacs/site-lisp

10 -RM ?= rm -f

11 -

12 -all: $(ELC)

13 -

14 -install: all

15 - $(INSTALL) -d $(DESTDIR)$(emacsdir)

16 - $(INSTALL_ELC) $(ELC:.elc=.el) $(ELC) $(DESTDIR)$(emacsdir)

17 -

18 -%.elc: %.el

19 - $(EMACS) -batch -f batch-byte-compile $<

20 -

21 -clean:; $(RM) $(ELC)

contrib/emacs/README

+13 -19

@@ -1,30 +1,24 @@

1 -This directory contains various modules for Emacs support.

1 +This directory used to contain various modules for Emacs support.

3 -To make the modules available to Emacs, you should add this directory

4 -to your load-path, and then require the modules you want. This can be

5 -done by adding to your .emacs something like this:

3 +These were added shortly after Git was first released. Since then

4 +Emacs's own support for Git got better than what was offered by these

5 +modes. There are also popular 3rd-party Git modes such as Magit which

6 +offer replacements for these.

7 - (add-to-list 'load-path ".../git/contrib/emacs")

8 - (require 'git)

9 - (require 'git-blame)

10 -

11 -

12 -The following modules are available:

8 +The following modules were available, and can be dug up from the Git

9 +history:

11 * git.el:

16 - Status manager that displays the state of all the files of the

17 - project, and provides easy access to the most frequently used git

18 - commands. The user interface is as far as possible compatible with

19 - the pcl-cvs mode. It can be started with `M-x git-status'.

13 + Wrapper for "git status" that provided access to other git commands.

14 +

15 + Modern alternatives to this include Magit, and VC mode that ships

16 + with Emacs.

18 * git-blame.el:

23 - Emacs implementation of incremental git-blame. When you turn it on

24 - while viewing a file, the editor buffer will be updated by setting

25 - the background of individual lines to a color that reflects which

26 - commit it comes from. And when you move around the buffer, a

27 - one-line summary will be shown in the echo area.

20 + A wrapper for "git blame" written before Emacs's own vc-annotate

21 + mode learned to invoke git-blame, which can be done via C-x v g.

23 * vc-git.el:

contrib/emacs/git-blame.el

+6 -483

@@ -1,483 +1,6 @@

1 -;;; git-blame.el --- Minor mode for incremental blame for Git -*- coding: utf-8 -*-

2 -;;

4 -;;

5 -;; Authors: David Kågedal <davidk@lysator.liu.se>

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, see

29 -;; <http://www.gnu.org/licenses/>.

30 -

31 -;; http://www.fsf.org/copyleft/gpl.html

32 -

33 -

34 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

35 -;;

36 -;;; Commentary:

37 -;;

38 -;; Here is an Emacs implementation of incremental git-blame. When you

39 -;; turn it on while viewing a file, the editor buffer will be updated by

40 -;; setting the background of individual lines to a color that reflects

41 -;; which commit it comes from. And when you move around the buffer, a

42 -;; one-line summary will be shown in the echo area.

43 -

44 -;;; Installation:

45 -;;

46 -;; To use this package, put it somewhere in `load-path' (or add

47 -;; directory with git-blame.el to `load-path'), and add the following

48 -;; line to your .emacs:

49 -;;

50 -;; (require 'git-blame)

51 -;;

52 -;; If you do not want to load this package before it is necessary, you

53 -;; can make use of the `autoload' feature, e.g. by adding to your .emacs

54 -;; the following lines

55 -;;

56 -;; (autoload 'git-blame-mode "git-blame"

57 -;; "Minor mode for incremental blame for Git." t)

58 -;;

59 -;; Then first use of `M-x git-blame-mode' would load the package.

60 -

61 -;;; Compatibility:

62 -;;

63 -;; It requires GNU Emacs 21 or later and Git 1.5.0 and up

64 -;;

65 -;; If you'are using Emacs 20, try changing this:

66 -;;

67 -;; (overlay-put ovl 'face (list :background

68 -;; (cdr (assq 'color (cddddr info)))))

69 -;;

70 -;; to

71 -;;

72 -;; (overlay-put ovl 'face (cons 'background-color

73 -;; (cdr (assq 'color (cddddr info)))))

74 -

75 -

76 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

77 -;;

78 -;;; Code:

79 -

80 -(eval-when-compile (require 'cl)) ; to use `push', `pop'

81 -(require 'format-spec)

82 -

83 -(defface git-blame-prefix-face

84 - '((((background dark)) (:foreground "gray"

85 - :background "black"))

86 - (((background light)) (:foreground "gray"

87 - :background "white"))

88 - (t (:weight bold)))

89 - "The face used for the hash prefix."

90 - :group 'git-blame)

91 -

92 -(defgroup git-blame nil

93 - "A minor mode showing Git blame information."

94 - :group 'git

95 - :link '(function-link git-blame-mode))

96 -

97 -

98 -(defcustom git-blame-use-colors t

99 - "Use colors to indicate commits in `git-blame-mode'."

100 - :type 'boolean

101 - :group 'git-blame)

102 -

103 -(defcustom git-blame-prefix-format

104 - "%h %20A:"

105 - "The format of the prefix added to each line in `git-blame'

106 -mode. The format is passed to `format-spec' with the following format keys:

107 -

108 - %h - the abbreviated hash

109 - %H - the full hash

110 - %a - the author name

111 - %A - the author email

112 - %c - the committer name

113 - %C - the committer email

114 - %s - the commit summary

115 -"

116 - :group 'git-blame)

117 -

118 -(defcustom git-blame-mouseover-format

119 - "%h %a %A: %s"

120 - "The format of the description shown when pointing at a line in

121 -`git-blame' mode. The format string is passed to `format-spec'

122 -with the following format keys:

123 -

124 - %h - the abbreviated hash

125 - %H - the full hash

126 - %a - the author name

127 - %A - the author email

128 - %c - the committer name

129 - %C - the committer email

130 - %s - the commit summary

131 -"

132 - :group 'git-blame)

133 -

134 -

135 -(defun git-blame-color-scale (&rest elements)

136 - "Given a list, returns a list of triples formed with each

137 -elements of the list.

138 -

139 -a b => bbb bba bab baa abb aba aaa aab"

140 - (let (result)

141 - (dolist (a elements)

142 - (dolist (b elements)

143 - (dolist (c elements)

144 - (setq result (cons (format "#%s%s%s" a b c) result)))))

145 - result))

146 -

147 -;; (git-blame-color-scale "0c" "04" "24" "1c" "2c" "34" "14" "3c") =>

148 -;; ("#3c3c3c" "#3c3c14" "#3c3c34" "#3c3c2c" "#3c3c1c" "#3c3c24"

149 -;; "#3c3c04" "#3c3c0c" "#3c143c" "#3c1414" "#3c1434" "#3c142c" ...)

150 -

151 -(defmacro git-blame-random-pop (l)

152 - "Select a random element from L and returns it. Also remove

153 -selected element from l."

154 - ;; only works on lists with unique elements

155 - `(let ((e (elt ,l (random (length ,l)))))

156 - (setq ,l (remove e ,l))

157 - e))

158 -

159 -(defvar git-blame-log-oneline-format

160 - "format:[%cr] %cn: %s"

161 - "*Formatting option used for describing current line in the minibuffer.

162 -

163 -This option is used to pass to git log --pretty= command-line option,

164 -and describe which commit the current line was made.")

165 -

166 -(defvar git-blame-dark-colors

167 - (git-blame-color-scale "0c" "04" "24" "1c" "2c" "34" "14" "3c")

168 - "*List of colors (format #RGB) to use in a dark environment.

169 -

170 -To check out the list, evaluate (list-colors-display git-blame-dark-colors).")

171 -

172 -(defvar git-blame-light-colors

173 - (git-blame-color-scale "c4" "d4" "cc" "dc" "f4" "e4" "fc" "ec")

174 - "*List of colors (format #RGB) to use in a light environment.

175 -

176 -To check out the list, evaluate (list-colors-display git-blame-light-colors).")

177 -

178 -(defvar git-blame-colors '()

179 - "Colors used by git-blame. The list is built once when activating git-blame

180 -minor mode.")

181 -

182 -(defvar git-blame-ancient-color "dark green"

183 - "*Color to be used for ancient commit.")

184 -

185 -(defvar git-blame-autoupdate t

186 - "*Automatically update the blame display while editing")

187 -

188 -(defvar git-blame-proc nil

189 - "The running git-blame process")

190 -(make-variable-buffer-local 'git-blame-proc)

191 -

192 -(defvar git-blame-overlays nil

193 - "The git-blame overlays used in the current buffer.")

194 -(make-variable-buffer-local 'git-blame-overlays)

195 -

196 -(defvar git-blame-cache nil

197 - "A cache of git-blame information for the current buffer")

198 -(make-variable-buffer-local 'git-blame-cache)

199 -

200 -(defvar git-blame-idle-timer nil

201 - "An idle timer that updates the blame")

202 -(make-variable-buffer-local 'git-blame-cache)

203 -

204 -(defvar git-blame-update-queue nil

205 - "A queue of update requests")

206 -(make-variable-buffer-local 'git-blame-update-queue)

207 -

208 -;; FIXME: docstrings

209 -(defvar git-blame-file nil)

210 -(defvar git-blame-current nil)

211 -

212 -(defvar git-blame-mode nil)

213 -(make-variable-buffer-local 'git-blame-mode)

214 -

215 -(defvar git-blame-mode-line-string " blame"

216 - "String to display on the mode line when git-blame is active.")

217 -

218 -(or (assq 'git-blame-mode minor-mode-alist)

219 - (setq minor-mode-alist

220 - (cons '(git-blame-mode git-blame-mode-line-string) minor-mode-alist)))

221 -

222 -;;;###autoload

223 -(defun git-blame-mode (&optional arg)

224 - "Toggle minor mode for displaying Git blame

225 -

226 -With prefix ARG, turn the mode on if ARG is positive."

227 - (interactive "P")

228 - (cond

229 - ((null arg)

230 - (if git-blame-mode (git-blame-mode-off) (git-blame-mode-on)))

231 - ((> (prefix-numeric-value arg) 0) (git-blame-mode-on))

232 - (t (git-blame-mode-off))))

233 -

234 -(defun git-blame-mode-on ()

235 - "Turn on git-blame mode.

236 -

237 -See also function `git-blame-mode'."

238 - (make-local-variable 'git-blame-colors)

239 - (if git-blame-autoupdate

240 - (add-hook 'after-change-functions 'git-blame-after-change nil t)

241 - (remove-hook 'after-change-functions 'git-blame-after-change t))

242 - (git-blame-cleanup)

243 - (let ((bgmode (cdr (assoc 'background-mode (frame-parameters)))))

244 - (if (eq bgmode 'dark)

245 - (setq git-blame-colors git-blame-dark-colors)

246 - (setq git-blame-colors git-blame-light-colors)))

247 - (setq git-blame-cache (make-hash-table :test 'equal))

248 - (setq git-blame-mode t)

249 - (git-blame-run))

250 -

251 -(defun git-blame-mode-off ()

252 - "Turn off git-blame mode.

253 -

254 -See also function `git-blame-mode'."

255 - (git-blame-cleanup)

256 - (if git-blame-idle-timer (cancel-timer git-blame-idle-timer))

257 - (setq git-blame-mode nil))

258 -

259 -;;;###autoload

260 -(defun git-reblame ()

261 - "Recalculate all blame information in the current buffer"

262 - (interactive)

263 - (unless git-blame-mode

264 - (error "Git-blame is not active"))

265 -

266 - (git-blame-cleanup)

267 - (git-blame-run))

268 -

269 -(defun git-blame-run (&optional startline endline)

270 - (if git-blame-proc

271 - ;; Should maybe queue up a new run here

272 - (message "Already running git blame")

273 - (let ((display-buf (current-buffer))

274 - (blame-buf (get-buffer-create

275 - (concat " git blame for " (buffer-name))))

276 - (args '("--incremental" "--contents" "-")))

277 - (if startline

278 - (setq args (append args

279 - (list "-L" (format "%d,%d" startline endline)))))

280 - (setq args (append args

281 - (list (file-name-nondirectory buffer-file-name))))

282 - (setq git-blame-proc

283 - (apply 'start-process

284 - "git-blame" blame-buf

285 - "git" "blame"

286 - args))

287 - (with-current-buffer blame-buf

288 - (erase-buffer)

289 - (make-local-variable 'git-blame-file)

290 - (make-local-variable 'git-blame-current)

291 - (setq git-blame-file display-buf)

292 - (setq git-blame-current nil))

293 - (set-process-filter git-blame-proc 'git-blame-filter)

294 - (set-process-sentinel git-blame-proc 'git-blame-sentinel)

295 - (process-send-region git-blame-proc (point-min) (point-max))

296 - (process-send-eof git-blame-proc))))

297 -

298 -(defun remove-git-blame-text-properties (start end)

299 - (let ((modified (buffer-modified-p))

300 - (inhibit-read-only t))

301 - (remove-text-properties start end '(point-entered nil))

302 - (set-buffer-modified-p modified)))

303 -

304 -(defun git-blame-cleanup ()

305 - "Remove all blame properties"

306 - (mapc 'delete-overlay git-blame-overlays)

307 - (setq git-blame-overlays nil)

308 - (remove-git-blame-text-properties (point-min) (point-max)))

309 -

310 -(defun git-blame-update-region (start end)

311 - "Rerun blame to get updates between START and END"

312 - (let ((overlays (overlays-in start end)))

313 - (while overlays

314 - (let ((overlay (pop overlays)))

315 - (if (< (overlay-start overlay) start)

316 - (setq start (overlay-start overlay)))

317 - (if (> (overlay-end overlay) end)

318 - (setq end (overlay-end overlay)))

319 - (setq git-blame-overlays (delete overlay git-blame-overlays))

320 - (delete-overlay overlay))))

321 - (remove-git-blame-text-properties start end)

322 - ;; We can be sure that start and end are at line breaks

323 - (git-blame-run (1+ (count-lines (point-min) start))

324 - (count-lines (point-min) end)))

325 -

326 -(defun git-blame-sentinel (proc status)

327 - (with-current-buffer (process-buffer proc)

328 - (with-current-buffer git-blame-file

329 - (setq git-blame-proc nil)

330 - (if git-blame-update-queue

331 - (git-blame-delayed-update))))

332 - ;;(kill-buffer (process-buffer proc))

333 - ;;(message "git blame finished")

334 - )

335 -

336 -(defvar in-blame-filter nil)

337 -

338 -(defun git-blame-filter (proc str)

339 - (with-current-buffer (process-buffer proc)

340 - (save-excursion

341 - (goto-char (process-mark proc))

342 - (insert-before-markers str)

343 - (goto-char (point-min))

344 - (unless in-blame-filter

345 - (let ((more t)

346 - (in-blame-filter t))

347 - (while more

348 - (setq more (git-blame-parse))))))))

349 -

350 -(defun git-blame-parse ()

351 - (cond ((looking-at "\$[0-9a-f]\\{40\\}\$ \$[0-9]+\$ \$[0-9]+\$ \$[0-9]+\$\n")

352 - (let ((hash (match-string 1))

353 - (src-line (string-to-number (match-string 2)))

354 - (res-line (string-to-number (match-string 3)))

355 - (num-lines (string-to-number (match-string 4))))

356 - (delete-region (point) (match-end 0))

357 - (setq git-blame-current (list (git-blame-new-commit hash)

358 - src-line res-line num-lines)))

359 - t)

360 - ((looking-at "\$[a-z-]+\$ \$.+\$\n")

361 - (let ((key (match-string 1))

362 - (value (match-string 2)))

363 - (delete-region (point) (match-end 0))

364 - (git-blame-add-info (car git-blame-current) key value)

365 - (when (string= key "filename")

366 - (git-blame-create-overlay (car git-blame-current)

367 - (caddr git-blame-current)

368 - (cadddr git-blame-current))

369 - (setq git-blame-current nil)))

370 - t)

371 - (t

372 - nil)))

373 -

374 -(defun git-blame-new-commit (hash)

375 - (with-current-buffer git-blame-file

376 - (or (gethash hash git-blame-cache)

377 - ;; Assign a random color to each new commit info

378 - ;; Take care not to select the same color multiple times

379 - (let* ((color (if git-blame-colors

380 - (git-blame-random-pop git-blame-colors)

381 - git-blame-ancient-color))

382 - (info `(,hash (color . ,color))))

383 - (puthash hash info git-blame-cache)

384 - info))))

385 -

386 -(defun git-blame-create-overlay (info start-line num-lines)

387 - (with-current-buffer git-blame-file

388 - (save-excursion

389 - (let ((inhibit-point-motion-hooks t)

390 - (inhibit-modification-hooks t))

391 - (goto-char (point-min))

392 - (forward-line (1- start-line))

393 - (let* ((start (point))

394 - (end (progn (forward-line num-lines) (point)))

395 - (ovl (make-overlay start end))

396 - (hash (car info))

397 - (spec `((?h . ,(substring hash 0 6))

398 - (?H . ,hash)

399 - (?a . ,(git-blame-get-info info 'author))

400 - (?A . ,(git-blame-get-info info 'author-mail))

401 - (?c . ,(git-blame-get-info info 'committer))

402 - (?C . ,(git-blame-get-info info 'committer-mail))

403 - (?s . ,(git-blame-get-info info 'summary)))))

404 - (push ovl git-blame-overlays)

405 - (overlay-put ovl 'git-blame info)

406 - (overlay-put ovl 'help-echo

407 - (format-spec git-blame-mouseover-format spec))

408 - (if git-blame-use-colors

409 - (overlay-put ovl 'face (list :background

410 - (cdr (assq 'color (cdr info))))))

411 - (overlay-put ovl 'line-prefix

412 - (propertize (format-spec git-blame-prefix-format spec)

413 - 'face 'git-blame-prefix-face)))))))

414 -

415 -(defun git-blame-add-info (info key value)

416 - (nconc info (list (cons (intern key) value))))

417 -

418 -(defun git-blame-get-info (info key)

419 - (cdr (assq key (cdr info))))

420 -

421 -(defun git-blame-current-commit ()

422 - (let ((info (get-char-property (point) 'git-blame)))

423 - (if info

424 - (car info)

425 - (error "No commit info"))))

426 -

427 -(defun git-describe-commit (hash)

428 - (with-temp-buffer

429 - (call-process "git" nil t nil

430 - "log" "-1"

431 - (concat "--pretty=" git-blame-log-oneline-format)

432 - hash)

433 - (buffer-substring (point-min) (point-max))))

434 -

435 -(defvar git-blame-last-identification nil)

436 -(make-variable-buffer-local 'git-blame-last-identification)

437 -(defun git-blame-identify (&optional hash)

438 - (interactive)

439 - (let ((info (gethash (or hash (git-blame-current-commit)) git-blame-cache)))

440 - (when (and info (not (eq info git-blame-last-identification)))

441 - (message "%s" (nth 4 info))

442 - (setq git-blame-last-identification info))))

443 -

444 -;; (defun git-blame-after-save ()

445 -;; (when git-blame-mode

446 -;; (git-blame-cleanup)

447 -;; (git-blame-run)))

448 -;; (add-hook 'after-save-hook 'git-blame-after-save)

449 -

450 -(defun git-blame-after-change (start end length)

451 - (when git-blame-mode

452 - (git-blame-enq-update start end)))

453 -

454 -(defvar git-blame-last-update nil)

455 -(make-variable-buffer-local 'git-blame-last-update)

456 -(defun git-blame-enq-update (start end)

457 - "Mark the region between START and END as needing blame update"

458 - ;; Try to be smart and avoid multiple callouts for sequential

459 - ;; editing

460 - (cond ((and git-blame-last-update

461 - (= start (cdr git-blame-last-update)))

462 - (setcdr git-blame-last-update end))

463 - ((and git-blame-last-update

464 - (= end (car git-blame-last-update)))

465 - (setcar git-blame-last-update start))

466 - (t

467 - (setq git-blame-last-update (cons start end))

468 - (setq git-blame-update-queue (nconc git-blame-update-queue

469 - (list git-blame-last-update)))))

470 - (unless (or git-blame-proc git-blame-idle-timer)

471 - (setq git-blame-idle-timer

472 - (run-with-idle-timer 0.5 nil 'git-blame-delayed-update))))

473 -

474 -(defun git-blame-delayed-update ()

475 - (setq git-blame-idle-timer nil)

476 - (if git-blame-update-queue

477 - (let ((first (pop git-blame-update-queue))

478 - (inhibit-point-motion-hooks t))

479 - (git-blame-update-region (car first) (cdr first)))))

480 -

481 -(provide 'git-blame)

482 -

483 -;;; git-blame.el ends here

1 +(error "git-blame.el no longer ships with git. It's recommended

2 +to replace its use with Emacs's own vc-annotate. See

3 +contrib/emacs/README in git's

4 +sources (https://github.com/git/git/blob/master/contrib/emacs/README)

5 +for more info on suggested alternatives and for why this

6 +happened.")

contrib/emacs/git.el

+6 -1704

@@ -1,1704 +1,6 @@

1 -;;; git.el --- A user interface for git

2 -

4 -

5 -;; Version: 1.0

6 -

7 -;; This program is free software; you can redistribute it and/or

8 -;; modify it under the terms of the GNU General Public License as

9 -;; published by the Free Software Foundation; either version 2 of

10 -;; the License, or (at your option) any later version.

11 -;;

12 -;; This program is distributed in the hope that it will be

13 -;; useful, but WITHOUT ANY WARRANTY; without even the implied

14 -;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR

15 -;; PURPOSE. See the GNU General Public License for more details.

16 -;;

17 -;; You should have received a copy of the GNU General Public

18 -;; License along with this program; if not, see

19 -;; <http://www.gnu.org/licenses/>.

20 -

21 -;;; Commentary:

22 -

23 -;; This file contains an interface for the git version control

24 -;; system. It provides easy access to the most frequently used git

25 -;; commands. The user interface is as far as possible identical to

26 -;; that of the PCL-CVS mode.

27 -;;

28 -;; To install: put this file on the load-path and place the following

29 -;; in your .emacs file:

30 -;;

31 -;; (require 'git)

32 -;;

33 -;; To start: `M-x git-status'

34 -;;

35 -;; TODO

36 -;; - diff against other branch

37 -;; - renaming files from the status buffer

38 -;; - creating tags

39 -;; - fetch/pull

40 -;; - revlist browser

41 -;; - git-show-branch browser

42 -;;

43 -

44 -;;; Compatibility:

45 -;;

46 -;; This file works on GNU Emacs 21 or later. It may work on older

47 -;; versions but this is not guaranteed.

48 -;;

49 -;; It may work on XEmacs 21, provided that you first install the ewoc

50 -;; and log-edit packages.

51 -;;

52 -

53 -(eval-when-compile (require 'cl))

54 -(require 'ewoc)

55 -(require 'log-edit)

56 -(require 'easymenu)

57 -

58 -

59 -;;;; Customizations

60 -;;;; ------------------------------------------------------------

61 -

62 -(defgroup git nil

63 - "A user interface for the git versioning system."

64 - :group 'tools)

65 -

66 -(defcustom git-committer-name nil

67 - "User name to use for commits.

68 -The default is to fall back to the repository config,

69 -then to `add-log-full-name' and then to `user-full-name'."

70 - :group 'git

71 - :type '(choice (const :tag "Default" nil)

72 - (string :tag "Name")))

73 -

74 -(defcustom git-committer-email nil

75 - "Email address to use for commits.

76 -The default is to fall back to the git repository config,

77 -then to `add-log-mailing-address' and then to `user-mail-address'."

78 - :group 'git

79 - :type '(choice (const :tag "Default" nil)

80 - (string :tag "Email")))

81 -

82 -(defcustom git-commits-coding-system nil

83 - "Default coding system for the log message of git commits."

84 - :group 'git

85 - :type '(choice (const :tag "From repository config" nil)

86 - (coding-system)))

87 -

88 -(defcustom git-append-signed-off-by nil

89 - "Whether to append a Signed-off-by line to the commit message before editing."

90 - :group 'git

91 - :type 'boolean)

92 -

93 -(defcustom git-reuse-status-buffer t

94 - "Whether `git-status' should try to reuse an existing buffer

95 -if there is already one that displays the same directory."

96 - :group 'git

97 - :type 'boolean)

98 -

99 -(defcustom git-per-dir-ignore-file ".gitignore"

100 - "Name of the per-directory ignore file."

101 - :group 'git

102 - :type 'string)

103 -

104 -(defcustom git-show-uptodate nil

105 - "Whether to display up-to-date files."

106 - :group 'git

107 - :type 'boolean)

108 -

109 -(defcustom git-show-ignored nil

110 - "Whether to display ignored files."

111 - :group 'git

112 - :type 'boolean)

113 -

114 -(defcustom git-show-unknown t

115 - "Whether to display unknown files."

116 - :group 'git

117 - :type 'boolean)

118 -

119 -

120 -(defface git-status-face

121 - '((((class color) (background light)) (:foreground "purple"))

122 - (((class color) (background dark)) (:foreground "salmon")))

123 - "Git mode face used to highlight added and modified files."

124 - :group 'git)

125 -

126 -(defface git-unmerged-face

127 - '((((class color) (background light)) (:foreground "red" :bold t))

128 - (((class color) (background dark)) (:foreground "red" :bold t)))

129 - "Git mode face used to highlight unmerged files."

130 - :group 'git)

131 -

132 -(defface git-unknown-face

133 - '((((class color) (background light)) (:foreground "goldenrod" :bold t))

134 - (((class color) (background dark)) (:foreground "goldenrod" :bold t)))

135 - "Git mode face used to highlight unknown files."

136 - :group 'git)

137 -

138 -(defface git-uptodate-face

139 - '((((class color) (background light)) (:foreground "grey60"))

140 - (((class color) (background dark)) (:foreground "grey40")))

141 - "Git mode face used to highlight up-to-date files."

142 - :group 'git)

143 -

144 -(defface git-ignored-face

145 - '((((class color) (background light)) (:foreground "grey60"))

146 - (((class color) (background dark)) (:foreground "grey40")))

147 - "Git mode face used to highlight ignored files."

148 - :group 'git)

149 -

150 -(defface git-mark-face

151 - '((((class color) (background light)) (:foreground "red" :bold t))

152 - (((class color) (background dark)) (:foreground "tomato" :bold t)))

153 - "Git mode face used for the file marks."

154 - :group 'git)

155 -

156 -(defface git-header-face

157 - '((((class color) (background light)) (:foreground "blue"))

158 - (((class color) (background dark)) (:foreground "blue")))

159 - "Git mode face used for commit headers."

160 - :group 'git)

161 -

162 -(defface git-separator-face

163 - '((((class color) (background light)) (:foreground "brown"))

164 - (((class color) (background dark)) (:foreground "brown")))

165 - "Git mode face used for commit separator."

166 - :group 'git)

167 -

168 -(defface git-permission-face

169 - '((((class color) (background light)) (:foreground "green" :bold t))

170 - (((class color) (background dark)) (:foreground "green" :bold t)))

171 - "Git mode face used for permission changes."

172 - :group 'git)

173 -

174 -

175 -;;;; Utilities

176 -;;;; ------------------------------------------------------------

177 -

178 -(defconst git-log-msg-separator "--- log message follows this line ---")

179 -

180 -(defvar git-log-edit-font-lock-keywords

181 - `(("^\$Author:\\|Date:\\|Merge:\\|Signed-off-by:\$\$.*\$$"

182 - (1 font-lock-keyword-face)

183 - (2 font-lock-function-name-face))

184 - (,(concat "^\$" (regexp-quote git-log-msg-separator) "\$$")

185 - (1 font-lock-comment-face))))

186 -

187 -(defun git-get-env-strings (env)

188 - "Build a list of NAME=VALUE strings from a list of environment strings."

189 - (mapcar (lambda (entry) (concat (car entry) "=" (cdr entry))) env))

190 -

191 -(defun git-call-process (buffer &rest args)

192 - "Wrapper for call-process that sets environment strings."

193 - (apply #'call-process "git" nil buffer nil args))

194 -

195 -(defun git-call-process-display-error (&rest args)

196 - "Wrapper for call-process that displays error messages."

197 - (let* ((dir default-directory)

198 - (buffer (get-buffer-create "*Git Command Output*"))

199 - (ok (with-current-buffer buffer

200 - (let ((default-directory dir)

201 - (buffer-read-only nil))

202 - (erase-buffer)

203 - (eq 0 (apply #'git-call-process (list buffer t) args))))))

204 - (unless ok (display-message-or-buffer buffer))

205 - ok))

206 -

207 -(defun git-call-process-string (&rest args)

208 - "Wrapper for call-process that returns the process output as a string,

209 -or nil if the git command failed."

210 - (with-temp-buffer

211 - (and (eq 0 (apply #'git-call-process t args))

212 - (buffer-string))))

213 -

214 -(defun git-call-process-string-display-error (&rest args)

215 - "Wrapper for call-process that displays error message and returns

216 -the process output as a string, or nil if the git command failed."

217 - (with-temp-buffer

218 - (if (eq 0 (apply #'git-call-process (list t t) args))

219 - (buffer-string)

220 - (display-message-or-buffer (current-buffer))

221 - nil)))

222 -

223 -(defun git-run-process-region (buffer start end program args)

224 - "Run a git process with a buffer region as input."

225 - (let ((output-buffer (current-buffer))

226 - (dir default-directory))

227 - (with-current-buffer buffer

228 - (cd dir)

229 - (apply #'call-process-region start end program

230 - nil (list output-buffer t) nil args))))

231 -

232 -(defun git-run-command-buffer (buffer-name &rest args)

233 - "Run a git command, sending the output to a buffer named BUFFER-NAME."

234 - (let ((dir default-directory)

235 - (buffer (get-buffer-create buffer-name)))

236 - (message "Running git %s..." (car args))

237 - (with-current-buffer buffer

238 - (let ((default-directory dir)

239 - (buffer-read-only nil))

240 - (erase-buffer)

241 - (apply #'git-call-process buffer args)))

242 - (message "Running git %s...done" (car args))

243 - buffer))

244 -

245 -(defun git-run-command-region (buffer start end env &rest args)

246 - "Run a git command with specified buffer region as input."

247 - (with-temp-buffer

248 - (if (eq 0 (if env

249 - (git-run-process-region

250 - buffer start end "env"

251 - (append (git-get-env-strings env) (list "git") args))

252 - (git-run-process-region buffer start end "git" args)))

253 - (buffer-string)

254 - (display-message-or-buffer (current-buffer))

255 - nil)))

256 -

257 -(defun git-run-hook (hook env &rest args)

258 - "Run a git hook and display its output if any."

259 - (let ((dir default-directory)

260 - (hook-name (expand-file-name (concat ".git/hooks/" hook))))

261 - (or (not (file-executable-p hook-name))

262 - (let (status (buffer (get-buffer-create "*Git Hook Output*")))

263 - (with-current-buffer buffer

264 - (erase-buffer)

265 - (cd dir)

266 - (setq status

267 - (if env

268 - (apply #'call-process "env" nil (list buffer t) nil

269 - (append (git-get-env-strings env) (list hook-name) args))

270 - (apply #'call-process hook-name nil (list buffer t) nil args))))

271 - (display-message-or-buffer buffer)

272 - (eq 0 status)))))

273 -

274 -(defun git-get-string-sha1 (string)

275 - "Read a SHA1 from the specified string."

276 - (and string

277 - (string-match "[0-9a-f]\\{40\\}" string)

278 - (match-string 0 string)))

279 -

280 -(defun git-get-committer-name ()

281 - "Return the name to use as GIT_COMMITTER_NAME."

282 - ; copied from log-edit

283 - (or git-committer-name

284 - (git-config "user.name")

285 - (and (boundp 'add-log-full-name) add-log-full-name)

286 - (and (fboundp 'user-full-name) (user-full-name))

287 - (and (boundp 'user-full-name) user-full-name)))

288 -

289 -(defun git-get-committer-email ()

290 - "Return the email address to use as GIT_COMMITTER_EMAIL."

291 - ; copied from log-edit

292 - (or git-committer-email

293 - (git-config "user.email")

294 - (and (boundp 'add-log-mailing-address) add-log-mailing-address)

295 - (and (fboundp 'user-mail-address) (user-mail-address))

296 - (and (boundp 'user-mail-address) user-mail-address)))

297 -

298 -(defun git-get-commits-coding-system ()

299 - "Return the coding system to use for commits."

300 - (let ((repo-config (git-config "i18n.commitencoding")))

301 - (or git-commits-coding-system

302 - (and repo-config

303 - (fboundp 'locale-charset-to-coding-system)

304 - (locale-charset-to-coding-system repo-config))

305 - 'utf-8)))

306 -

307 -(defun git-get-logoutput-coding-system ()

308 - "Return the coding system used for git-log output."

309 - (let ((repo-config (or (git-config "i18n.logoutputencoding")

310 - (git-config "i18n.commitencoding"))))

311 - (or git-commits-coding-system

312 - (and repo-config

313 - (fboundp 'locale-charset-to-coding-system)

314 - (locale-charset-to-coding-system repo-config))

315 - 'utf-8)))

316 -

317 -(defun git-escape-file-name (name)

318 - "Escape a file name if necessary."

319 - (if (string-match "[\n\t\"\\]" name)

320 - (concat "\""

321 - (mapconcat (lambda (c)

322 - (case c

323 - (?\n "\\n")

324 - (?\t "\\t")

325 - (?\\ "\\\\")

326 - (?\" "\\\"")

327 - (t (char-to-string c))))

328 - name "")

329 - "\"")

330 - name))

331 -

332 -(defun git-success-message (text files)

333 - "Print a success message after having handled FILES."

334 - (let ((n (length files)))

335 - (if (equal n 1)

336 - (message "%s %s" text (car files))

337 - (message "%s %d files" text n))))

338 -

339 -(defun git-get-top-dir (dir)

340 - "Retrieve the top-level directory of a git tree."

341 - (let ((cdup (with-output-to-string

342 - (with-current-buffer standard-output

343 - (cd dir)

344 - (unless (eq 0 (git-call-process t "rev-parse" "--show-cdup"))

345 - (error "cannot find top-level git tree for %s." dir))))))

346 - (expand-file-name (concat (file-name-as-directory dir)

347 - (car (split-string cdup "\n"))))))

348 -

349 -;stolen from pcl-cvs

350 -(defun git-append-to-ignore (file)

351 - "Add a file name to the ignore file in its directory."

352 - (let* ((fullname (expand-file-name file))

353 - (dir (file-name-directory fullname))

354 - (name (file-name-nondirectory fullname))

355 - (ignore-name (expand-file-name git-per-dir-ignore-file dir))

356 - (created (not (file-exists-p ignore-name))))

357 - (save-window-excursion

358 - (set-buffer (find-file-noselect ignore-name))

359 - (goto-char (point-max))

360 - (unless (zerop (current-column)) (insert "\n"))

361 - (insert "/" name "\n")

362 - (sort-lines nil (point-min) (point-max))

363 - (save-buffer))

364 - (when created

365 - (git-call-process nil "update-index" "--add" "--" (file-relative-name ignore-name)))

366 - (git-update-status-files (list (file-relative-name ignore-name)))))

367 -

368 -; propertize definition for XEmacs, stolen from erc-compat

369 -(eval-when-compile

370 - (unless (fboundp 'propertize)

371 - (defun propertize (string &rest props)

372 - (let ((string (copy-sequence string)))

373 - (while props

374 - (put-text-property 0 (length string) (nth 0 props) (nth 1 props) string)

375 - (setq props (cddr props)))

376 - string))))

377 -

378 -;;;; Wrappers for basic git commands

379 -;;;; ------------------------------------------------------------

380 -

381 -(defun git-rev-parse (rev)

382 - "Parse a revision name and return its SHA1."

383 - (git-get-string-sha1

384 - (git-call-process-string "rev-parse" rev)))

385 -

386 -(defun git-config (key)

387 - "Retrieve the value associated to KEY in the git repository config file."

388 - (let ((str (git-call-process-string "config" key)))

389 - (and str (car (split-string str "\n")))))

390 -

391 -(defun git-symbolic-ref (ref)

392 - "Wrapper for the git-symbolic-ref command."

393 - (let ((str (git-call-process-string "symbolic-ref" ref)))

394 - (and str (car (split-string str "\n")))))

395 -

396 -(defun git-update-ref (ref newval &optional oldval reason)

397 - "Update a reference by calling git-update-ref."

398 - (let ((args (and oldval (list oldval))))

399 - (when newval (push newval args))

400 - (push ref args)

401 - (when reason

402 - (push reason args)

403 - (push "-m" args))

404 - (unless newval (push "-d" args))

405 - (apply 'git-call-process-display-error "update-ref" args)))

406 -

407 -(defun git-for-each-ref (&rest specs)

408 - "Return a list of refs using git-for-each-ref.

409 -Each entry is a cons of (SHORT-NAME . FULL-NAME)."

410 - (let (refs)

411 - (with-temp-buffer

412 - (apply #'git-call-process t "for-each-ref" "--format=%(refname)" specs)

413 - (goto-char (point-min))

414 - (while (re-search-forward "^[^/\n]+/[^/\n]+/\$.+\$$" nil t)

415 - (push (cons (match-string 1) (match-string 0)) refs)))

416 - (nreverse refs)))

417 -

418 -(defun git-read-tree (tree &optional index-file)

419 - "Read a tree into the index file."

420 - (let ((process-environment

421 - (append (and index-file (list (concat "GIT_INDEX_FILE=" index-file))) process-environment)))

422 - (apply 'git-call-process-display-error "read-tree" (if tree (list tree)))))

423 -

424 -(defun git-write-tree (&optional index-file)

425 - "Call git-write-tree and return the resulting tree SHA1 as a string."

426 - (let ((process-environment

427 - (append (and index-file (list (concat "GIT_INDEX_FILE=" index-file))) process-environment)))

428 - (git-get-string-sha1

429 - (git-call-process-string-display-error "write-tree"))))

430 -

431 -(defun git-commit-tree (buffer tree parent)

432 - "Create a commit and possibly update HEAD.

433 -Create a commit with the message in BUFFER using the tree with hash TREE.

434 -Use PARENT as the parent of the new commit. If PARENT is the current \"HEAD\",

435 -update the \"HEAD\" reference to the new commit."

436 - (let ((author-name (git-get-committer-name))

437 - (author-email (git-get-committer-email))

438 - (subject "commit (initial): ")

439 - author-date log-start log-end args coding-system-for-write)

440 - (when parent

441 - (setq subject "commit: ")

442 - (push "-p" args)

443 - (push parent args))

444 - (with-current-buffer buffer

445 - (goto-char (point-min))

446 - (if

447 - (setq log-start (re-search-forward (concat "^" (regexp-quote git-log-msg-separator) "\n") nil t))

448 - (save-restriction

449 - (narrow-to-region (point-min) log-start)

450 - (goto-char (point-min))

451 - (when (re-search-forward "^Author: +\$.*?\$ *<\$.*\$> *$" nil t)

452 - (setq author-name (match-string 1)

453 - author-email (match-string 2)))

454 - (goto-char (point-min))

455 - (when (re-search-forward "^Date: +\$.*\$$" nil t)

456 - (setq author-date (match-string 1)))

457 - (goto-char (point-min))

458 - (when (re-search-forward "^Merge: +\$.*\$" nil t)

459 - (setq subject "commit (merge): ")

460 - (dolist (parent (split-string (match-string 1) " +" t))

461 - (push "-p" args)

462 - (push parent args))))

463 - (setq log-start (point-min)))

464 - (setq log-end (point-max))

465 - (goto-char log-start)

466 - (when (re-search-forward ".*$" nil t)

467 - (setq subject (concat subject (match-string 0))))

468 - (setq coding-system-for-write buffer-file-coding-system))

469 - (let ((commit

470 - (git-get-string-sha1

471 - (let ((env `(("GIT_AUTHOR_NAME" . ,author-name)

472 - ("GIT_AUTHOR_EMAIL" . ,author-email)

473 - ("GIT_COMMITTER_NAME" . ,(git-get-committer-name))

474 - ("GIT_COMMITTER_EMAIL" . ,(git-get-committer-email)))))

475 - (when author-date (push `("GIT_AUTHOR_DATE" . ,author-date) env))

476 - (apply #'git-run-command-region

477 - buffer log-start log-end env

478 - "commit-tree" tree (nreverse args))))))

479 - (when commit (git-update-ref "HEAD" commit parent subject))

480 - commit)))

481 -

482 -(defun git-empty-db-p ()

483 - "Check if the git db is empty (no commit done yet)."

484 - (not (eq 0 (git-call-process nil "rev-parse" "--verify" "HEAD"))))

485 -

486 -(defun git-get-merge-heads ()

487 - "Retrieve the merge heads from the MERGE_HEAD file if present."

488 - (let (heads)

489 - (when (file-readable-p ".git/MERGE_HEAD")

490 - (with-temp-buffer

491 - (insert-file-contents ".git/MERGE_HEAD" nil nil nil t)

492 - (goto-char (point-min))

493 - (while (re-search-forward "[0-9a-f]\\{40\\}" nil t)

494 - (push (match-string 0) heads))))

495 - (nreverse heads)))

496 -

497 -(defun git-get-commit-description (commit)

498 - "Get a one-line description of COMMIT."

499 - (let ((coding-system-for-read (git-get-logoutput-coding-system)))

500 - (let ((descr (git-call-process-string "log" "--max-count=1" "--pretty=oneline" commit)))

501 - (if (and descr (string-match "\\`\$[0-9a-f]\\{40\\}\$ *\$.*\$$" descr))

502 - (concat (substring (match-string 1 descr) 0 10) " - " (match-string 2 descr))

503 - descr))))

504 -

505 -;;;; File info structure

506 -;;;; ------------------------------------------------------------

507 -

508 -; fileinfo structure stolen from pcl-cvs

509 -(defstruct (git-fileinfo

510 - (:copier nil)

511 - (:constructor git-create-fileinfo (state name &optional old-perm new-perm rename-state orig-name marked))

512 - (:conc-name git-fileinfo->))

513 - marked ;; t/nil

514 - state ;; current state

515 - name ;; file name

516 - old-perm new-perm ;; permission flags

517 - rename-state ;; rename or copy state

518 - orig-name ;; original name for renames or copies

519 - needs-update ;; whether file needs to be updated

520 - needs-refresh) ;; whether file needs to be refreshed

521 -

522 -(defvar git-status nil)

523 -

524 -(defun git-set-fileinfo-state (info state)

525 - "Set the state of a file info."

526 - (unless (eq (git-fileinfo->state info) state)

527 - (setf (git-fileinfo->state info) state

528 - (git-fileinfo->new-perm info) (git-fileinfo->old-perm info)

529 - (git-fileinfo->rename-state info) nil

530 - (git-fileinfo->orig-name info) nil

531 - (git-fileinfo->needs-update info) nil

532 - (git-fileinfo->needs-refresh info) t)))

533 -

534 -(defun git-status-filenames-map (status func files &rest args)

535 - "Apply FUNC to the status files names in the FILES list.

536 -The list must be sorted."

537 - (when files

538 - (let ((file (pop files))

539 - (node (ewoc-nth status 0)))

540 - (while (and file node)

541 - (let* ((info (ewoc-data node))

542 - (name (git-fileinfo->name info)))

543 - (if (string-lessp name file)

544 - (setq node (ewoc-next status node))

545 - (if (string-equal name file)

546 - (apply func info args))

547 - (setq file (pop files))))))))

548 -

549 -(defun git-set-filenames-state (status files state)

550 - "Set the state of a list of named files. The list must be sorted"

551 - (when files

552 - (git-status-filenames-map status #'git-set-fileinfo-state files state)

553 - (unless state ;; delete files whose state has been set to nil

554 - (ewoc-filter status (lambda (info) (git-fileinfo->state info))))))

555 -

556 -(defun git-state-code (code)

557 - "Convert from a string to a added/deleted/modified state."

558 - (case (string-to-char code)

559 - (?M 'modified)

560 - (?? 'unknown)

561 - (?A 'added)

562 - (?D 'deleted)

563 - (?U 'unmerged)

564 - (?T 'modified)

565 - (t nil)))

566 -

567 -(defun git-status-code-as-string (code)

568 - "Format a git status code as string."

569 - (case code

570 - ('modified (propertize "Modified" 'face 'git-status-face))

571 - ('unknown (propertize "Unknown " 'face 'git-unknown-face))

572 - ('added (propertize "Added " 'face 'git-status-face))

573 - ('deleted (propertize "Deleted " 'face 'git-status-face))

574 - ('unmerged (propertize "Unmerged" 'face 'git-unmerged-face))

575 - ('uptodate (propertize "Uptodate" 'face 'git-uptodate-face))

576 - ('ignored (propertize "Ignored " 'face 'git-ignored-face))

577 - (t "? ")))

578 -

579 -(defun git-file-type-as-string (old-perm new-perm)

580 - "Return a string describing the file type based on its permissions."

581 - (let* ((old-type (lsh (or old-perm 0) -9))

582 - (new-type (lsh (or new-perm 0) -9))

583 - (str (case new-type

584 - (64 ;; file

585 - (case old-type

586 - (64 nil)

587 - (80 " (type change symlink -> file)")

588 - (112 " (type change subproject -> file)")))

589 - (80 ;; symlink

590 - (case old-type

591 - (64 " (type change file -> symlink)")

592 - (112 " (type change subproject -> symlink)")

593 - (t " (symlink)")))

594 - (112 ;; subproject

595 - (case old-type

596 - (64 " (type change file -> subproject)")

597 - (80 " (type change symlink -> subproject)")

598 - (t " (subproject)")))

599 - (72 nil) ;; directory (internal, not a real git state)

600 - (0 ;; deleted or unknown

601 - (case old-type

602 - (80 " (symlink)")

603 - (112 " (subproject)")))

604 - (t (format " (unknown type %o)" new-type)))))

605 - (cond (str (propertize str 'face 'git-status-face))

606 - ((eq new-type 72) "/")

607 - (t ""))))

608 -

609 -(defun git-rename-as-string (info)

610 - "Return a string describing the copy or rename associated with INFO, or an empty string if none."

611 - (let ((state (git-fileinfo->rename-state info)))

612 - (if state

613 - (propertize

614 - (concat " ("

615 - (if (eq state 'copy) "copied from "

616 - (if (eq (git-fileinfo->state info) 'added) "renamed from "

617 - "renamed to "))

618 - (git-escape-file-name (git-fileinfo->orig-name info))

619 - ")") 'face 'git-status-face)

620 - "")))

621 -

622 -(defun git-permissions-as-string (old-perm new-perm)

623 - "Format a permission change as string."

624 - (propertize

625 - (if (or (not old-perm)

626 - (not new-perm)

627 - (eq 0 (logand ?\111 (logxor old-perm new-perm))))

628 - " "

629 - (if (eq 0 (logand ?\111 old-perm)) "+x" "-x"))

630 - 'face 'git-permission-face))

631 -

632 -(defun git-fileinfo-prettyprint (info)

633 - "Pretty-printer for the git-fileinfo structure."

634 - (let ((old-perm (git-fileinfo->old-perm info))

635 - (new-perm (git-fileinfo->new-perm info)))

636 - (insert (concat " " (if (git-fileinfo->marked info) (propertize "*" 'face 'git-mark-face) " ")

637 - " " (git-status-code-as-string (git-fileinfo->state info))

638 - " " (git-permissions-as-string old-perm new-perm)

639 - " " (git-escape-file-name (git-fileinfo->name info))

640 - (git-file-type-as-string old-perm new-perm)

641 - (git-rename-as-string info)))))

642 -

643 -(defun git-update-node-fileinfo (node info)

644 - "Update the fileinfo of the specified node. The names are assumed to match already."

645 - (let ((data (ewoc-data node)))

646 - (setf

647 - ;; preserve the marked flag

648 - (git-fileinfo->marked info) (git-fileinfo->marked data)

649 - (git-fileinfo->needs-update data) nil)

650 - (when (not (equal info data))

651 - (setf (git-fileinfo->needs-refresh info) t

652 - (ewoc-data node) info))))

653 -

654 -(defun git-insert-info-list (status infolist files)

655 - "Insert a sorted list of file infos in the status buffer, replacing existing ones if any."

656 - (let* ((info (pop infolist))

657 - (node (ewoc-nth status 0))

658 - (name (and info (git-fileinfo->name info)))

659 - remaining)

660 - (while info

661 - (let ((nodename (and node (git-fileinfo->name (ewoc-data node)))))

662 - (while (and files (string-lessp (car files) name))

663 - (push (pop files) remaining))

664 - (when (and files (string-equal (car files) name))

665 - (setq files (cdr files)))

666 - (cond ((not nodename)

667 - (setq node (ewoc-enter-last status info))

668 - (setq info (pop infolist))

669 - (setq name (and info (git-fileinfo->name info))))

670 - ((string-lessp nodename name)

671 - (setq node (ewoc-next status node)))

672 - ((string-equal nodename name)

673 - ;; preserve the marked flag

674 - (git-update-node-fileinfo node info)

675 - (setq info (pop infolist))

676 - (setq name (and info (git-fileinfo->name info))))

677 - (t

678 - (setq node (ewoc-enter-before status node info))

679 - (setq info (pop infolist))

680 - (setq name (and info (git-fileinfo->name info)))))))

681 - (nconc (nreverse remaining) files)))

682 -

683 -(defun git-run-diff-index (status files)

684 - "Run git-diff-index on FILES and parse the results into STATUS.

685 -Return the list of files that haven't been handled."

686 - (let (infolist)

687 - (with-temp-buffer

688 - (apply #'git-call-process t "diff-index" "-z" "-M" "HEAD" "--" files)

689 - (goto-char (point-min))

690 - (while (re-search-forward

691 - ":\$[0-7]\\{6\\}\$ \$[0-7]\\{6\\}\$ [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \$\\([ADMUT]\$\0\$[^\0]+\$\\|\$[CR]\$[0-9]*\0\$[^\0]+\$\0\$[^\0]+\$\\)\0"

692 - nil t 1)

693 - (let ((old-perm (string-to-number (match-string 1) 8))

694 - (new-perm (string-to-number (match-string 2) 8))

695 - (state (or (match-string 4) (match-string 6)))

696 - (name (or (match-string 5) (match-string 7)))

697 - (new-name (match-string 8)))

698 - (if new-name ; copy or rename

699 - (if (eq ?C (string-to-char state))

700 - (push (git-create-fileinfo 'added new-name old-perm new-perm 'copy name) infolist)

701 - (push (git-create-fileinfo 'deleted name 0 0 'rename new-name) infolist)

702 - (push (git-create-fileinfo 'added new-name old-perm new-perm 'rename name) infolist))

703 - (push (git-create-fileinfo (git-state-code state) name old-perm new-perm) infolist)))))

704 - (setq infolist (sort (nreverse infolist)

705 - (lambda (info1 info2)

706 - (string-lessp (git-fileinfo->name info1)

707 - (git-fileinfo->name info2)))))

708 - (git-insert-info-list status infolist files)))

709 -

710 -(defun git-find-status-file (status file)

711 - "Find a given file in the status ewoc and return its node."

712 - (let ((node (ewoc-nth status 0)))

713 - (while (and node (not (string= file (git-fileinfo->name (ewoc-data node)))))

714 - (setq node (ewoc-next status node)))

715 - node))

716 -

717 -(defun git-run-ls-files (status files default-state &rest options)

718 - "Run git-ls-files on FILES and parse the results into STATUS.

719 -Return the list of files that haven't been handled."

720 - (let (infolist)

721 - (with-temp-buffer

722 - (apply #'git-call-process t "ls-files" "-z" (append options (list "--") files))

723 - (goto-char (point-min))

724 - (while (re-search-forward "\$[^\0]*?\$\$/?\$\0" nil t 1)

725 - (let ((name (match-string 1)))

726 - (push (git-create-fileinfo default-state name 0

727 - (if (string-equal "/" (match-string 2)) (lsh ?\110 9) 0))

728 - infolist))))

729 - (setq infolist (nreverse infolist)) ;; assume it is sorted already

730 - (git-insert-info-list status infolist files)))

731 -

732 -(defun git-run-ls-files-cached (status files default-state)

733 - "Run git-ls-files -c on FILES and parse the results into STATUS.

734 -Return the list of files that haven't been handled."

735 - (let (infolist)

736 - (with-temp-buffer

737 - (apply #'git-call-process t "ls-files" "-z" "-s" "-c" "--" files)

738 - (goto-char (point-min))

739 - (while (re-search-forward "\$[0-7]\\{6\\}\$ [0-9a-f]\\{40\\} 0\t\$[^\0]+\$\0" nil t)

740 - (let* ((new-perm (string-to-number (match-string 1) 8))

741 - (old-perm (if (eq default-state 'added) 0 new-perm))

742 - (name (match-string 2)))

743 - (push (git-create-fileinfo default-state name old-perm new-perm) infolist))))

744 - (setq infolist (nreverse infolist)) ;; assume it is sorted already

745 - (git-insert-info-list status infolist files)))

746 -

747 -(defun git-run-ls-unmerged (status files)

748 - "Run git-ls-files -u on FILES and parse the results into STATUS."

749 - (with-temp-buffer

750 - (apply #'git-call-process t "ls-files" "-z" "-u" "--" files)

751 - (goto-char (point-min))

752 - (let (unmerged-files)

753 - (while (re-search-forward "[0-7]\\{6\\} [0-9a-f]\\{40\\} [123]\t\$[^\0]+\$\0" nil t)

754 - (push (match-string 1) unmerged-files))

755 - (setq unmerged-files (nreverse unmerged-files)) ;; assume it is sorted already

756 - (git-set-filenames-state status unmerged-files 'unmerged))))

757 -

758 -(defun git-get-exclude-files ()

759 - "Get the list of exclude files to pass to git-ls-files."

760 - (let (files

761 - (config (git-config "core.excludesfile")))

762 - (when (file-readable-p ".git/info/exclude")

763 - (push ".git/info/exclude" files))

764 - (when (and config (file-readable-p config))

765 - (push config files))

766 - files))

767 -

768 -(defun git-run-ls-files-with-excludes (status files default-state &rest options)

769 - "Run git-ls-files on FILES with appropriate --exclude-from options."

770 - (let ((exclude-files (git-get-exclude-files)))

771 - (apply #'git-run-ls-files status files default-state "--directory" "--no-empty-directory"

772 - (concat "--exclude-per-directory=" git-per-dir-ignore-file)

773 - (append options (mapcar (lambda (f) (concat "--exclude-from=" f)) exclude-files)))))

774 -

775 -(defun git-update-status-files (&optional files mark-files)

776 - "Update the status of FILES from the index.

777 -The FILES list must be sorted."

778 - (unless git-status (error "Not in git-status buffer."))

779 - ;; set the needs-update flag on existing files

780 - (if files

781 - (git-status-filenames-map

782 - git-status (lambda (info) (setf (git-fileinfo->needs-update info) t)) files)

783 - (ewoc-map (lambda (info) (setf (git-fileinfo->needs-update info) t) nil) git-status)

784 - (git-call-process nil "update-index" "--refresh")

785 - (when git-show-uptodate

786 - (git-run-ls-files-cached git-status nil 'uptodate)))

787 - (let ((remaining-files

788 - (if (git-empty-db-p) ; we need some special handling for an empty db

789 - (git-run-ls-files-cached git-status files 'added)

790 - (git-run-diff-index git-status files))))

791 - (git-run-ls-unmerged git-status files)

792 - (when (or remaining-files (and git-show-unknown (not files)))

793 - (setq remaining-files (git-run-ls-files-with-excludes git-status remaining-files 'unknown "-o")))

794 - (when (or remaining-files (and git-show-ignored (not files)))

795 - (setq remaining-files (git-run-ls-files-with-excludes git-status remaining-files 'ignored "-o" "-i")))

796 - (unless files

797 - (setq remaining-files (git-get-filenames (ewoc-collect git-status #'git-fileinfo->needs-update))))

798 - (when remaining-files

799 - (setq remaining-files (git-run-ls-files-cached git-status remaining-files 'uptodate)))

800 - (git-set-filenames-state git-status remaining-files nil)

801 - (when mark-files (git-mark-files git-status files))

802 - (git-refresh-files)

803 - (git-refresh-ewoc-hf git-status)))

804 -

805 -(defun git-mark-files (status files)

806 - "Mark all the specified FILES, and unmark the others."

807 - (let ((file (and files (pop files)))

808 - (node (ewoc-nth status 0)))

809 - (while node

810 - (let ((info (ewoc-data node)))

811 - (if (and file (string-equal (git-fileinfo->name info) file))

812 - (progn

813 - (unless (git-fileinfo->marked info)

814 - (setf (git-fileinfo->marked info) t)

815 - (setf (git-fileinfo->needs-refresh info) t))

816 - (setq file (pop files))

817 - (setq node (ewoc-next status node)))

818 - (when (git-fileinfo->marked info)

819 - (setf (git-fileinfo->marked info) nil)

820 - (setf (git-fileinfo->needs-refresh info) t))

821 - (if (and file (string-lessp file (git-fileinfo->name info)))

822 - (setq file (pop files))

823 - (setq node (ewoc-next status node))))))))

824 -

825 -(defun git-marked-files ()

826 - "Return a list of all marked files, or if none a list containing just the file at cursor position."

827 - (unless git-status (error "Not in git-status buffer."))

828 - (or (ewoc-collect git-status (lambda (info) (git-fileinfo->marked info)))

829 - (list (ewoc-data (ewoc-locate git-status)))))

830 -

831 -(defun git-marked-files-state (&rest states)

832 - "Return a sorted list of marked files that are in the specified states."

833 - (let ((files (git-marked-files))

834 - result)

835 - (dolist (info files)

836 - (when (memq (git-fileinfo->state info) states)

837 - (push info result)))

838 - (nreverse result)))

839 -

840 -(defun git-refresh-files ()

841 - "Refresh all files that need it and clear the needs-refresh flag."

842 - (unless git-status (error "Not in git-status buffer."))

843 - (ewoc-map

844 - (lambda (info)

845 - (let ((refresh (git-fileinfo->needs-refresh info)))

846 - (setf (git-fileinfo->needs-refresh info) nil)

847 - refresh))

848 - git-status)

849 - ; move back to goal column

850 - (when goal-column (move-to-column goal-column)))

851 -

852 -(defun git-refresh-ewoc-hf (status)

853 - "Refresh the ewoc header and footer."

854 - (let ((branch (git-symbolic-ref "HEAD"))

855 - (head (if (git-empty-db-p) "Nothing committed yet"

856 - (git-get-commit-description "HEAD")))

857 - (merge-heads (git-get-merge-heads)))

858 - (ewoc-set-hf status

859 - (format "Directory: %s\nBranch: %s\nHead: %s%s\n"

860 - default-directory

861 - (if branch

862 - (if (string-match "^refs/heads/" branch)

863 - (substring branch (match-end 0))

864 - branch)

865 - "none (detached HEAD)")

866 - head

867 - (if merge-heads

868 - (concat "\nMerging: "

869 - (mapconcat (lambda (str) (git-get-commit-description str)) merge-heads "\n "))

870 - ""))

871 - (if (ewoc-nth status 0) "" " No changes."))))

872 -

873 -(defun git-get-filenames (files)

874 - (mapcar (lambda (info) (git-fileinfo->name info)) files))

875 -

876 -(defun git-update-index (index-file files)

877 - "Run git-update-index on a list of files."

878 - (let ((process-environment (append (and index-file (list (concat "GIT_INDEX_FILE=" index-file)))

879 - process-environment))

880 - added deleted modified)

881 - (dolist (info files)

882 - (case (git-fileinfo->state info)

883 - ('added (push info added))

884 - ('deleted (push info deleted))

885 - ('modified (push info modified))))

886 - (and

887 - (or (not added) (apply #'git-call-process-display-error "update-index" "--add" "--" (git-get-filenames added)))

888 - (or (not deleted) (apply #'git-call-process-display-error "update-index" "--remove" "--" (git-get-filenames deleted)))

889 - (or (not modified) (apply #'git-call-process-display-error "update-index" "--" (git-get-filenames modified))))))

890 -

891 -(defun git-run-pre-commit-hook ()

892 - "Run the pre-commit hook if any."

893 - (unless git-status (error "Not in git-status buffer."))

894 - (let ((files (git-marked-files-state 'added 'deleted 'modified)))

895 - (or (not files)

896 - (not (file-executable-p ".git/hooks/pre-commit"))

897 - (let ((index-file (make-temp-file "gitidx")))

898 - (unwind-protect

899 - (let ((head-tree (unless (git-empty-db-p) (git-rev-parse "HEAD^{tree}"))))

900 - (git-read-tree head-tree index-file)

901 - (git-update-index index-file files)

902 - (git-run-hook "pre-commit" `(("GIT_INDEX_FILE" . ,index-file))))

903 - (delete-file index-file))))))

904 -

905 -(defun git-do-commit ()

906 - "Perform the actual commit using the current buffer as log message."

907 - (interactive)

908 - (let ((buffer (current-buffer))

909 - (index-file (make-temp-file "gitidx")))

910 - (with-current-buffer log-edit-parent-buffer

911 - (if (git-marked-files-state 'unmerged)

912 - (message "You cannot commit unmerged files, resolve them first.")

913 - (unwind-protect

914 - (let ((files (git-marked-files-state 'added 'deleted 'modified))

915 - head tree head-tree)

916 - (unless (git-empty-db-p)

917 - (setq head (git-rev-parse "HEAD")

918 - head-tree (git-rev-parse "HEAD^{tree}")))

919 - (message "Running git commit...")

920 - (when

921 - (and

922 - (git-read-tree head-tree index-file)

923 - (git-update-index nil files) ;update both the default index

924 - (git-update-index index-file files) ;and the temporary one

925 - (setq tree (git-write-tree index-file)))

926 - (if (or (not (string-equal tree head-tree))

927 - (yes-or-no-p "The tree was not modified, do you really want to perform an empty commit? "))

928 - (let ((commit (git-commit-tree buffer tree head)))

929 - (when commit

930 - (condition-case nil (delete-file ".git/MERGE_HEAD") (error nil))

931 - (condition-case nil (delete-file ".git/MERGE_MSG") (error nil))

932 - (with-current-buffer buffer (erase-buffer))

933 - (git-update-status-files (git-get-filenames files))

934 - (git-call-process nil "rerere")

935 - (git-call-process nil "gc" "--auto")

936 - (message "Committed %s." commit)

937 - (git-run-hook "post-commit" nil)))

938 - (message "Commit aborted."))))

939 - (delete-file index-file))))))

940 -

941 -

942 -;;;; Interactive functions

943 -;;;; ------------------------------------------------------------

944 -

945 -(defun git-mark-file ()

946 - "Mark the file that the cursor is on and move to the next one."

947 - (interactive)

948 - (unless git-status (error "Not in git-status buffer."))

949 - (let* ((pos (ewoc-locate git-status))

950 - (info (ewoc-data pos)))

951 - (setf (git-fileinfo->marked info) t)

952 - (ewoc-invalidate git-status pos)

953 - (ewoc-goto-next git-status 1)))

954 -

955 -(defun git-unmark-file ()

956 - "Unmark the file that the cursor is on and move to the next one."

957 - (interactive)

958 - (unless git-status (error "Not in git-status buffer."))

959 - (let* ((pos (ewoc-locate git-status))

960 - (info (ewoc-data pos)))

961 - (setf (git-fileinfo->marked info) nil)

962 - (ewoc-invalidate git-status pos)

963 - (ewoc-goto-next git-status 1)))

964 -

965 -(defun git-unmark-file-up ()

966 - "Unmark the file that the cursor is on and move to the previous one."

967 - (interactive)

968 - (unless git-status (error "Not in git-status buffer."))

969 - (let* ((pos (ewoc-locate git-status))

970 - (info (ewoc-data pos)))

971 - (setf (git-fileinfo->marked info) nil)

972 - (ewoc-invalidate git-status pos)

973 - (ewoc-goto-prev git-status 1)))

974 -

975 -(defun git-mark-all ()

976 - "Mark all files."

977 - (interactive)

978 - (unless git-status (error "Not in git-status buffer."))

979 - (ewoc-map (lambda (info) (unless (git-fileinfo->marked info)

980 - (setf (git-fileinfo->marked info) t))) git-status)

981 - ; move back to goal column after invalidate

982 - (when goal-column (move-to-column goal-column)))

983 -

984 -(defun git-unmark-all ()

985 - "Unmark all files."

986 - (interactive)

987 - (unless git-status (error "Not in git-status buffer."))

988 - (ewoc-map (lambda (info) (when (git-fileinfo->marked info)

989 - (setf (git-fileinfo->marked info) nil)

990 - t)) git-status)

991 - ; move back to goal column after invalidate

992 - (when goal-column (move-to-column goal-column)))

993 -

994 -(defun git-toggle-all-marks ()

995 - "Toggle all file marks."

996 - (interactive)

997 - (unless git-status (error "Not in git-status buffer."))

998 - (ewoc-map (lambda (info) (setf (git-fileinfo->marked info) (not (git-fileinfo->marked info))) t) git-status)

999 - ; move back to goal column after invalidate

1000 - (when goal-column (move-to-column goal-column)))

1001 -

1002 -(defun git-next-file (&optional n)

1003 - "Move the selection down N files."

1004 - (interactive "p")

1005 - (unless git-status (error "Not in git-status buffer."))

1006 - (ewoc-goto-next git-status n))

1007 -

1008 -(defun git-prev-file (&optional n)

1009 - "Move the selection up N files."

1010 - (interactive "p")

1011 - (unless git-status (error "Not in git-status buffer."))

1012 - (ewoc-goto-prev git-status n))

1013 -

1014 -(defun git-next-unmerged-file (&optional n)

1015 - "Move the selection down N unmerged files."

1016 - (interactive "p")

1017 - (unless git-status (error "Not in git-status buffer."))

1018 - (let* ((last (ewoc-locate git-status))

1019 - (node (ewoc-next git-status last)))

1020 - (while (and node (> n 0))

1021 - (when (eq 'unmerged (git-fileinfo->state (ewoc-data node)))

1022 - (setq n (1- n))

1023 - (setq last node))

1024 - (setq node (ewoc-next git-status node)))

1025 - (ewoc-goto-node git-status last)))

1026 -

1027 -(defun git-prev-unmerged-file (&optional n)

1028 - "Move the selection up N unmerged files."

1029 - (interactive "p")

1030 - (unless git-status (error "Not in git-status buffer."))

1031 - (let* ((last (ewoc-locate git-status))

1032 - (node (ewoc-prev git-status last)))

1033 - (while (and node (> n 0))

1034 - (when (eq 'unmerged (git-fileinfo->state (ewoc-data node)))

1035 - (setq n (1- n))

1036 - (setq last node))

1037 - (setq node (ewoc-prev git-status node)))

1038 - (ewoc-goto-node git-status last)))

1039 -

1040 -(defun git-insert-file (file)

1041 - "Insert file(s) into the git-status buffer."

1042 - (interactive "fInsert file: ")

1043 - (git-update-status-files (list (file-relative-name file))))

1044 -

1045 -(defun git-add-file ()

1046 - "Add marked file(s) to the index cache."

1047 - (interactive)

1048 - (let ((files (git-get-filenames (git-marked-files-state 'unknown 'ignored 'unmerged))))

1049 - ;; FIXME: add support for directories

1050 - (unless files

1051 - (push (file-relative-name (read-file-name "File to add: " nil nil t)) files))

1052 - (when (apply 'git-call-process-display-error "update-index" "--add" "--" files)

1053 - (git-update-status-files files)

1054 - (git-success-message "Added" files))))

1055 -

1056 -(defun git-ignore-file ()

1057 - "Add marked file(s) to the ignore list."

1058 - (interactive)

1059 - (let ((files (git-get-filenames (git-marked-files-state 'unknown))))

1060 - (unless files

1061 - (push (file-relative-name (read-file-name "File to ignore: " nil nil t)) files))

1062 - (dolist (f files) (git-append-to-ignore f))

1063 - (git-update-status-files files)

1064 - (git-success-message "Ignored" files)))

1065 -

1066 -(defun git-remove-file ()

1067 - "Remove the marked file(s)."

1068 - (interactive)

1069 - (let ((files (git-get-filenames (git-marked-files-state 'added 'modified 'unknown 'uptodate 'ignored))))

1070 - (unless files

1071 - (push (file-relative-name (read-file-name "File to remove: " nil nil t)) files))

1072 - (if (yes-or-no-p

1073 - (if (cdr files)

1074 - (format "Remove %d files? " (length files))

1075 - (format "Remove %s? " (car files))))

1076 - (progn

1077 - (dolist (name files)

1078 - (ignore-errors

1079 - (if (file-directory-p name)

1080 - (delete-directory name)

1081 - (delete-file name))))

1082 - (when (apply 'git-call-process-display-error "update-index" "--remove" "--" files)

1083 - (git-update-status-files files)

1084 - (git-success-message "Removed" files)))

1085 - (message "Aborting"))))

1086 -

1087 -(defun git-revert-file ()

1088 - "Revert changes to the marked file(s)."

1089 - (interactive)

1090 - (let ((files (git-marked-files-state 'added 'deleted 'modified 'unmerged))

1091 - added modified)

1092 - (when (and files

1093 - (yes-or-no-p

1094 - (if (cdr files)

1095 - (format "Revert %d files? " (length files))

1096 - (format "Revert %s? " (git-fileinfo->name (car files))))))

1097 - (dolist (info files)

1098 - (case (git-fileinfo->state info)

1099 - ('added (push (git-fileinfo->name info) added))

1100 - ('deleted (push (git-fileinfo->name info) modified))

1101 - ('unmerged (push (git-fileinfo->name info) modified))

1102 - ('modified (push (git-fileinfo->name info) modified))))

1103 - ;; check if a buffer contains one of the files and isn't saved

1104 - (dolist (file modified)

1105 - (let ((buffer (get-file-buffer file)))

1106 - (when (and buffer (buffer-modified-p buffer))

1107 - (error "Buffer %s is modified. Please kill or save modified buffers before reverting." (buffer-name buffer)))))

1108 - (let ((ok (and

1109 - (or (not added)

1110 - (apply 'git-call-process-display-error "update-index" "--force-remove" "--" added))

1111 - (or (not modified)

1112 - (apply 'git-call-process-display-error "checkout" "HEAD" modified))))

1113 - (names (git-get-filenames files)))

1114 - (git-update-status-files names)

1115 - (when ok

1116 - (dolist (file modified)

1117 - (let ((buffer (get-file-buffer file)))

1118 - (when buffer (with-current-buffer buffer (revert-buffer t t t)))))

1119 - (git-success-message "Reverted" names))))))

1120 -

1121 -(defun git-remove-handled ()

1122 - "Remove handled files from the status list."

1123 - (interactive)

1124 - (ewoc-filter git-status

1125 - (lambda (info)

1126 - (case (git-fileinfo->state info)

1127 - ('ignored git-show-ignored)

1128 - ('uptodate git-show-uptodate)

1129 - ('unknown git-show-unknown)

1130 - (t t))))

1131 - (unless (ewoc-nth git-status 0) ; refresh header if list is empty

1132 - (git-refresh-ewoc-hf git-status)))

1133 -

1134 -(defun git-toggle-show-uptodate ()

1135 - "Toogle the option for showing up-to-date files."

1136 - (interactive)

1137 - (if (setq git-show-uptodate (not git-show-uptodate))

1138 - (git-refresh-status)

1139 - (git-remove-handled)))

1140 -

1141 -(defun git-toggle-show-ignored ()

1142 - "Toogle the option for showing ignored files."

1143 - (interactive)

1144 - (if (setq git-show-ignored (not git-show-ignored))

1145 - (progn

1146 - (message "Inserting ignored files...")

1147 - (git-run-ls-files-with-excludes git-status nil 'ignored "-o" "-i")

1148 - (git-refresh-files)

1149 - (git-refresh-ewoc-hf git-status)

1150 - (message "Inserting ignored files...done"))

1151 - (git-remove-handled)))

1152 -

1153 -(defun git-toggle-show-unknown ()

1154 - "Toogle the option for showing unknown files."

1155 - (interactive)

1156 - (if (setq git-show-unknown (not git-show-unknown))

1157 - (progn

1158 - (message "Inserting unknown files...")

1159 - (git-run-ls-files-with-excludes git-status nil 'unknown "-o")

1160 - (git-refresh-files)

1161 - (git-refresh-ewoc-hf git-status)

1162 - (message "Inserting unknown files...done"))

1163 - (git-remove-handled)))

1164 -

1165 -(defun git-expand-directory (info)

1166 - "Expand the directory represented by INFO to list its files."

1167 - (when (eq (lsh (git-fileinfo->new-perm info) -9) ?\110)

1168 - (let ((dir (git-fileinfo->name info)))

1169 - (git-set-filenames-state git-status (list dir) nil)

1170 - (git-run-ls-files-with-excludes git-status (list (concat dir "/")) 'unknown "-o")

1171 - (git-refresh-files)

1172 - (git-refresh-ewoc-hf git-status)

1173 - t)))

1174 -

1175 -(defun git-setup-diff-buffer (buffer)

1176 - "Setup a buffer for displaying a diff."

1177 - (let ((dir default-directory))

1178 - (with-current-buffer buffer

1179 - (diff-mode)

1180 - (goto-char (point-min))

1181 - (setq default-directory dir)

1182 - (setq buffer-read-only t)))

1183 - (display-buffer buffer)

1184 - ; shrink window only if it displays the status buffer

1185 - (when (eq (window-buffer) (current-buffer))

1186 - (shrink-window-if-larger-than-buffer)))

1187 -

1188 -(defun git-diff-file ()

1189 - "Diff the marked file(s) against HEAD."

1190 - (interactive)

1191 - (let ((files (git-marked-files)))

1192 - (git-setup-diff-buffer

1193 - (apply #'git-run-command-buffer "*git-diff*" "diff-index" "-p" "-M" "HEAD" "--" (git-get-filenames files)))))

1194 -

1195 -(defun git-diff-file-merge-head (arg)

1196 - "Diff the marked file(s) against the first merge head (or the nth one with a numeric prefix)."

1197 - (interactive "p")

1198 - (let ((files (git-marked-files))

1199 - (merge-heads (git-get-merge-heads)))

1200 - (unless merge-heads (error "No merge in progress"))

1201 - (git-setup-diff-buffer

1202 - (apply #'git-run-command-buffer "*git-diff*" "diff-index" "-p" "-M"

1203 - (or (nth (1- arg) merge-heads) "HEAD") "--" (git-get-filenames files)))))

1204 -

1205 -(defun git-diff-unmerged-file (stage)

1206 - "Diff the marked unmerged file(s) against the specified stage."

1207 - (let ((files (git-marked-files)))

1208 - (git-setup-diff-buffer

1209 - (apply #'git-run-command-buffer "*git-diff*" "diff-files" "-p" stage "--" (git-get-filenames files)))))

1210 -

1211 -(defun git-diff-file-base ()

1212 - "Diff the marked unmerged file(s) against the common base file."

1213 - (interactive)

1214 - (git-diff-unmerged-file "-1"))

1215 -

1216 -(defun git-diff-file-mine ()

1217 - "Diff the marked unmerged file(s) against my pre-merge version."

1218 - (interactive)

1219 - (git-diff-unmerged-file "-2"))

1220 -

1221 -(defun git-diff-file-other ()

1222 - "Diff the marked unmerged file(s) against the other's pre-merge version."

1223 - (interactive)

1224 - (git-diff-unmerged-file "-3"))

1225 -

1226 -(defun git-diff-file-combined ()

1227 - "Do a combined diff of the marked unmerged file(s)."

1228 - (interactive)

1229 - (git-diff-unmerged-file "-c"))

1230 -

1231 -(defun git-diff-file-idiff ()

1232 - "Perform an interactive diff on the current file."

1233 - (interactive)

1234 - (let ((files (git-marked-files-state 'added 'deleted 'modified)))

1235 - (unless (eq 1 (length files))

1236 - (error "Cannot perform an interactive diff on multiple files."))

1237 - (let* ((filename (car (git-get-filenames files)))

1238 - (buff1 (find-file-noselect filename))

1239 - (buff2 (git-run-command-buffer (concat filename ".~HEAD~") "cat-file" "blob" (concat "HEAD:" filename))))

1240 - (ediff-buffers buff1 buff2))))

1241 -

1242 -(defun git-log-file ()

1243 - "Display a log of changes to the marked file(s)."

1244 - (interactive)

1245 - (let* ((files (git-marked-files))

1246 - (coding-system-for-read git-commits-coding-system)

1247 - (buffer (apply #'git-run-command-buffer "*git-log*" "rev-list" "--pretty" "HEAD" "--" (git-get-filenames files))))

1248 - (with-current-buffer buffer

1249 - ; (git-log-mode) FIXME: implement log mode

1250 - (goto-char (point-min))

1251 - (setq buffer-read-only t))

1252 - (display-buffer buffer)))

1253 -

1254 -(defun git-log-edit-files ()

1255 - "Return a list of marked files for use in the log-edit buffer."

1256 - (with-current-buffer log-edit-parent-buffer

1257 - (git-get-filenames (git-marked-files-state 'added 'deleted 'modified))))

1258 -

1259 -(defun git-log-edit-diff ()

1260 - "Run a diff of the current files being committed from a log-edit buffer."

1261 - (with-current-buffer log-edit-parent-buffer

1262 - (git-diff-file)))

1263 -

1264 -(defun git-append-sign-off (name email)

1265 - "Append a Signed-off-by entry to the current buffer, avoiding duplicates."

1266 - (let ((sign-off (format "Signed-off-by: %s <%s>" name email))

1267 - (case-fold-search t))

1268 - (goto-char (point-min))

1269 - (unless (re-search-forward (concat "^" (regexp-quote sign-off)) nil t)

1270 - (goto-char (point-min))

1271 - (unless (re-search-forward "^Signed-off-by: " nil t)

1272 - (setq sign-off (concat "\n" sign-off)))

1273 - (goto-char (point-max))

1274 - (insert sign-off "\n"))))

1275 -

1276 -(defun git-setup-log-buffer (buffer &optional merge-heads author-name author-email subject date msg)

1277 - "Setup the log buffer for a commit."

1278 - (unless git-status (error "Not in git-status buffer."))

1279 - (let ((dir default-directory)

1280 - (committer-name (git-get-committer-name))

1281 - (committer-email (git-get-committer-email))

1282 - (sign-off git-append-signed-off-by))

1283 - (with-current-buffer buffer

1284 - (cd dir)

1285 - (erase-buffer)

1286 - (insert

1287 - (propertize

1288 - (format "Author: %s <%s>\n%s%s"

1289 - (or author-name committer-name)

1290 - (or author-email committer-email)

1291 - (if date (format "Date: %s\n" date) "")

1292 - (if merge-heads

1293 - (format "Merge: %s\n"

1294 - (mapconcat 'identity merge-heads " "))

1295 - ""))

1296 - 'face 'git-header-face)

1297 - (propertize git-log-msg-separator 'face 'git-separator-face)

1298 - "\n")

1299 - (when subject (insert subject "\n\n"))

1300 - (cond (msg (insert msg "\n"))

1301 - ((file-readable-p ".git/rebase-apply/msg")

1302 - (insert-file-contents ".git/rebase-apply/msg"))

1303 - ((file-readable-p ".git/MERGE_MSG")

1304 - (insert-file-contents ".git/MERGE_MSG")))

1305 - ; delete empty lines at end

1306 - (goto-char (point-min))

1307 - (when (re-search-forward "\n+\\'" nil t)

1308 - (replace-match "\n" t t))

1309 - (when sign-off (git-append-sign-off committer-name committer-email)))

1310 - buffer))

1311 -

1312 -(define-derived-mode git-log-edit-mode log-edit-mode "Git-Log-Edit"

1313 - "Major mode for editing git log messages.

1314 -

1315 -Set up git-specific `font-lock-keywords' for `log-edit-mode'."

1316 - (set (make-local-variable 'font-lock-defaults)

1317 - '(git-log-edit-font-lock-keywords t t)))

1318 -

1319 -(defun git-commit-file ()

1320 - "Commit the marked file(s), asking for a commit message."

1321 - (interactive)

1322 - (unless git-status (error "Not in git-status buffer."))

1323 - (when (git-run-pre-commit-hook)

1324 - (let ((buffer (get-buffer-create "*git-commit*"))

1325 - (coding-system (git-get-commits-coding-system))

1326 - author-name author-email subject date)

1327 - (when (eq 0 (buffer-size buffer))

1328 - (when (file-readable-p ".git/rebase-apply/info")

1329 - (with-temp-buffer

1330 - (insert-file-contents ".git/rebase-apply/info")

1331 - (goto-char (point-min))

1332 - (when (re-search-forward "^Author: \$.*\$\nEmail: \$.*\$$" nil t)

1333 - (setq author-name (match-string 1))

1334 - (setq author-email (match-string 2)))

1335 - (goto-char (point-min))

1336 - (when (re-search-forward "^Subject: \$.*\$$" nil t)

1337 - (setq subject (match-string 1)))

1338 - (goto-char (point-min))

1339 - (when (re-search-forward "^Date: \$.*\$$" nil t)

1340 - (setq date (match-string 1)))))

1341 - (git-setup-log-buffer buffer (git-get-merge-heads) author-name author-email subject date))

1342 - (if (boundp 'log-edit-diff-function)

1343 - (log-edit 'git-do-commit nil '((log-edit-listfun . git-log-edit-files)

1344 - (log-edit-diff-function . git-log-edit-diff)) buffer 'git-log-edit-mode)

1345 - (log-edit 'git-do-commit nil 'git-log-edit-files buffer

1346 - 'git-log-edit-mode))

1348 - (setq buffer-file-coding-system coding-system)

1349 - (re-search-forward (regexp-quote (concat git-log-msg-separator "\n")) nil t))))

1350 -

1351 -(defun git-setup-commit-buffer (commit)

1352 - "Setup the commit buffer with the contents of COMMIT."

1353 - (let (parents author-name author-email subject date msg)

1354 - (with-temp-buffer

1355 - (let ((coding-system (git-get-logoutput-coding-system)))

1356 - (git-call-process t "log" "-1" "--pretty=medium" "--abbrev=40" commit)

1357 - (goto-char (point-min))

1358 - (when (re-search-forward "^Merge: *\$.*\$$" nil t)

1359 - (setq parents (cdr (split-string (match-string 1) " +"))))

1360 - (when (re-search-forward "^Author: *\$.*\$ <\$.*\$>$" nil t)

1361 - (setq author-name (match-string 1))

1362 - (setq author-email (match-string 2)))

1363 - (when (re-search-forward "^Date: *\$.*\$$" nil t)

1364 - (setq date (match-string 1)))

1365 - (while (re-search-forward "^ \$.*\$$" nil t)

1366 - (push (match-string 1) msg))

1367 - (setq msg (nreverse msg))

1368 - (setq subject (pop msg))

1369 - (while (and msg (zerop (length (car msg))) (pop msg)))))

1370 - (git-setup-log-buffer (get-buffer-create "*git-commit*")

1371 - parents author-name author-email subject date

1372 - (mapconcat #'identity msg "\n"))))

1373 -

1374 -(defun git-get-commit-files (commit)

1375 - "Retrieve a sorted list of files modified by COMMIT."

1376 - (let (files)

1377 - (with-temp-buffer

1378 - (git-call-process t "diff-tree" "-m" "-r" "-z" "--name-only" "--no-commit-id" "--root" commit)

1379 - (goto-char (point-min))

1380 - (while (re-search-forward "\$[^\0]*\$\0" nil t 1)

1381 - (push (match-string 1) files)))

1382 - (sort files #'string-lessp)))

1383 -

1384 -(defun git-read-commit-name (prompt &optional default)

1385 - "Ask for a commit name, with completion for local branch, remote branch and tag."

1386 - (completing-read prompt

1387 - (list* "HEAD" "ORIG_HEAD" "FETCH_HEAD" (mapcar #'car (git-for-each-ref)))

1388 - nil nil nil nil default))

1389 -

1390 -(defun git-checkout (branch &optional merge)

1391 - "Checkout a branch, tag, or any commit.

1392 -Use a prefix arg if git should merge while checking out."

1393 - (interactive

1394 - (list (git-read-commit-name "Checkout: ")

1395 - current-prefix-arg))

1396 - (unless git-status (error "Not in git-status buffer."))

1397 - (let ((args (list branch "--")))

1398 - (when merge (push "-m" args))

1399 - (when (apply #'git-call-process-display-error "checkout" args)

1400 - (git-update-status-files))))

1401 -

1402 -(defun git-branch (branch)

1403 - "Create a branch from the current HEAD and switch to it."

1404 - (interactive (list (git-read-commit-name "Branch: ")))

1405 - (unless git-status (error "Not in git-status buffer."))

1406 - (if (git-rev-parse (concat "refs/heads/" branch))

1407 - (if (yes-or-no-p (format "Branch %s already exists, replace it? " branch))

1408 - (and (git-call-process-display-error "branch" "-f" branch)

1409 - (git-call-process-display-error "checkout" branch))

1410 - (message "Canceled."))

1411 - (git-call-process-display-error "checkout" "-b" branch))

1412 - (git-refresh-ewoc-hf git-status))

1413 -

1414 -(defun git-amend-commit ()

1415 - "Undo the last commit on HEAD, and set things up to commit an

1416 -amended version of it."

1417 - (interactive)

1418 - (unless git-status (error "Not in git-status buffer."))

1419 - (when (git-empty-db-p) (error "No commit to amend."))

1420 - (let* ((commit (git-rev-parse "HEAD"))

1421 - (files (git-get-commit-files commit)))

1422 - (when (if (git-rev-parse "HEAD^")

1423 - (git-call-process-display-error "reset" "--soft" "HEAD^")

1424 - (and (git-update-ref "ORIG_HEAD" commit)

1425 - (git-update-ref "HEAD" nil commit)))

1426 - (git-update-status-files files t)

1427 - (git-setup-commit-buffer commit)

1428 - (git-commit-file))))

1429 -

1430 -(defun git-cherry-pick-commit (arg)

1431 - "Cherry-pick a commit."

1432 - (interactive (list (git-read-commit-name "Cherry-pick commit: ")))

1433 - (unless git-status (error "Not in git-status buffer."))

1434 - (let ((commit (git-rev-parse (concat arg "^0"))))

1435 - (unless commit (error "Not a valid commit '%s'." arg))

1436 - (when (git-rev-parse (concat commit "^2"))

1437 - (error "Cannot cherry-pick a merge commit."))

1438 - (let ((files (git-get-commit-files commit))

1439 - (ok (git-call-process-display-error "cherry-pick" "-n" commit)))

1440 - (git-update-status-files files ok)

1441 - (with-current-buffer (git-setup-commit-buffer commit)

1442 - (goto-char (point-min))

1443 - (if (re-search-forward "^\n*Signed-off-by:" nil t 1)

1444 - (goto-char (match-beginning 0))

1445 - (goto-char (point-max)))

1446 - (insert "(cherry picked from commit " commit ")\n"))

1447 - (when ok (git-commit-file)))))

1448 -

1449 -(defun git-revert-commit (arg)

1450 - "Revert a commit."

1451 - (interactive (list (git-read-commit-name "Revert commit: ")))

1452 - (unless git-status (error "Not in git-status buffer."))

1453 - (let ((commit (git-rev-parse (concat arg "^0"))))

1454 - (unless commit (error "Not a valid commit '%s'." arg))

1455 - (when (git-rev-parse (concat commit "^2"))

1456 - (error "Cannot revert a merge commit."))

1457 - (let ((files (git-get-commit-files commit))

1458 - (subject (git-get-commit-description commit))

1459 - (ok (git-call-process-display-error "revert" "-n" commit)))

1460 - (git-update-status-files files ok)

1461 - (when (string-match "^[0-9a-f]+ - \$.*\$$" subject)

1462 - (setq subject (match-string 1 subject)))

1463 - (git-setup-log-buffer (get-buffer-create "*git-commit*")

1464 - (git-get-merge-heads) nil nil (format "Revert \"%s\"" subject) nil

1465 - (format "This reverts commit %s.\n" commit))

1466 - (when ok (git-commit-file)))))

1467 -

1468 -(defun git-find-file ()

1469 - "Visit the current file in its own buffer."

1470 - (interactive)

1471 - (unless git-status (error "Not in git-status buffer."))

1472 - (let ((info (ewoc-data (ewoc-locate git-status))))

1473 - (unless (git-expand-directory info)

1474 - (find-file (git-fileinfo->name info))

1475 - (when (eq 'unmerged (git-fileinfo->state info))

1476 - (smerge-mode 1)))))

1477 -

1478 -(defun git-find-file-other-window ()

1479 - "Visit the current file in its own buffer in another window."

1480 - (interactive)

1481 - (unless git-status (error "Not in git-status buffer."))

1482 - (let ((info (ewoc-data (ewoc-locate git-status))))

1483 - (find-file-other-window (git-fileinfo->name info))

1484 - (when (eq 'unmerged (git-fileinfo->state info))

1485 - (smerge-mode))))

1486 -

1487 -(defun git-find-file-imerge ()

1488 - "Visit the current file in interactive merge mode."

1489 - (interactive)

1490 - (unless git-status (error "Not in git-status buffer."))

1491 - (let ((info (ewoc-data (ewoc-locate git-status))))

1492 - (find-file (git-fileinfo->name info))

1493 - (smerge-ediff)))

1494 -

1495 -(defun git-view-file ()

1496 - "View the current file in its own buffer."

1497 - (interactive)

1498 - (unless git-status (error "Not in git-status buffer."))

1499 - (let ((info (ewoc-data (ewoc-locate git-status))))

1500 - (view-file (git-fileinfo->name info))))

1501 -

1502 -(defun git-refresh-status ()

1503 - "Refresh the git status buffer."

1504 - (interactive)

1505 - (unless git-status (error "Not in git-status buffer."))

1506 - (message "Refreshing git status...")

1507 - (git-update-status-files)

1508 - (message "Refreshing git status...done"))

1509 -

1510 -(defun git-status-quit ()

1511 - "Quit git-status mode."

1512 - (interactive)

1513 - (bury-buffer))

1514 -

1515 -;;;; Major Mode

1516 -;;;; ------------------------------------------------------------

1517 -

1518 -(defvar git-status-mode-hook nil

1519 - "Run after `git-status-mode' is setup.")

1520 -

1521 -(defvar git-status-mode-map nil

1522 - "Keymap for git major mode.")

1523 -

1524 -(defvar git-status nil

1525 - "List of all files managed by the git-status mode.")

1526 -

1527 -(unless git-status-mode-map

1528 - (let ((map (make-keymap))

1529 - (commit-map (make-sparse-keymap))

1530 - (diff-map (make-sparse-keymap))

1531 - (toggle-map (make-sparse-keymap)))

1532 - (suppress-keymap map)

1533 - (define-key map "?" 'git-help)

1534 - (define-key map "h" 'git-help)

1535 - (define-key map " " 'git-next-file)

1536 - (define-key map "a" 'git-add-file)

1537 - (define-key map "c" 'git-commit-file)

1538 - (define-key map "\C-c" commit-map)

1539 - (define-key map "d" diff-map)

1540 - (define-key map "=" 'git-diff-file)

1541 - (define-key map "f" 'git-find-file)

1542 - (define-key map "\r" 'git-find-file)

1543 - (define-key map "g" 'git-refresh-status)

1544 - (define-key map "i" 'git-ignore-file)

1545 - (define-key map "I" 'git-insert-file)

1546 - (define-key map "l" 'git-log-file)

1547 - (define-key map "m" 'git-mark-file)

1548 - (define-key map "M" 'git-mark-all)

1549 - (define-key map "n" 'git-next-file)

1550 - (define-key map "N" 'git-next-unmerged-file)

1551 - (define-key map "o" 'git-find-file-other-window)

1552 - (define-key map "p" 'git-prev-file)

1553 - (define-key map "P" 'git-prev-unmerged-file)

1554 - (define-key map "q" 'git-status-quit)

1555 - (define-key map "r" 'git-remove-file)

1556 - (define-key map "t" toggle-map)

1557 - (define-key map "T" 'git-toggle-all-marks)

1558 - (define-key map "u" 'git-unmark-file)

1559 - (define-key map "U" 'git-revert-file)

1560 - (define-key map "v" 'git-view-file)

1561 - (define-key map "x" 'git-remove-handled)

1562 - (define-key map "\C-?" 'git-unmark-file-up)

1563 - (define-key map "\M-\C-?" 'git-unmark-all)

1564 - ; the commit submap

1565 - (define-key commit-map "\C-a" 'git-amend-commit)

1566 - (define-key commit-map "\C-b" 'git-branch)

1567 - (define-key commit-map "\C-o" 'git-checkout)

1568 - (define-key commit-map "\C-p" 'git-cherry-pick-commit)

1569 - (define-key commit-map "\C-v" 'git-revert-commit)

1570 - ; the diff submap

1571 - (define-key diff-map "b" 'git-diff-file-base)

1572 - (define-key diff-map "c" 'git-diff-file-combined)

1573 - (define-key diff-map "=" 'git-diff-file)

1574 - (define-key diff-map "e" 'git-diff-file-idiff)

1575 - (define-key diff-map "E" 'git-find-file-imerge)

1576 - (define-key diff-map "h" 'git-diff-file-merge-head)

1577 - (define-key diff-map "m" 'git-diff-file-mine)

1578 - (define-key diff-map "o" 'git-diff-file-other)

1579 - ; the toggle submap

1580 - (define-key toggle-map "u" 'git-toggle-show-uptodate)

1581 - (define-key toggle-map "i" 'git-toggle-show-ignored)

1582 - (define-key toggle-map "k" 'git-toggle-show-unknown)

1583 - (define-key toggle-map "m" 'git-toggle-all-marks)

1584 - (setq git-status-mode-map map))

1585 - (easy-menu-define git-menu git-status-mode-map

1586 - "Git Menu"

1587 - `("Git"

1588 - ["Refresh" git-refresh-status t]

1589 - ["Commit" git-commit-file t]

1590 - ["Checkout..." git-checkout t]

1591 - ["New Branch..." git-branch t]

1592 - ["Cherry-pick Commit..." git-cherry-pick-commit t]

1593 - ["Revert Commit..." git-revert-commit t]

1594 - ("Merge"

1595 - ["Next Unmerged File" git-next-unmerged-file t]

1596 - ["Prev Unmerged File" git-prev-unmerged-file t]

1597 - ["Interactive Merge File" git-find-file-imerge t]

1598 - ["Diff Against Common Base File" git-diff-file-base t]

1599 - ["Diff Combined" git-diff-file-combined t]

1600 - ["Diff Against Merge Head" git-diff-file-merge-head t]

1601 - ["Diff Against Mine" git-diff-file-mine t]

1602 - ["Diff Against Other" git-diff-file-other t])

1603 - "--------"

1604 - ["Add File" git-add-file t]

1605 - ["Revert File" git-revert-file t]

1606 - ["Ignore File" git-ignore-file t]

1607 - ["Remove File" git-remove-file t]

1608 - ["Insert File" git-insert-file t]

1609 - "--------"

1610 - ["Find File" git-find-file t]

1611 - ["View File" git-view-file t]

1612 - ["Diff File" git-diff-file t]

1613 - ["Interactive Diff File" git-diff-file-idiff t]

1614 - ["Log" git-log-file t]

1615 - "--------"

1616 - ["Mark" git-mark-file t]

1617 - ["Mark All" git-mark-all t]

1618 - ["Unmark" git-unmark-file t]

1619 - ["Unmark All" git-unmark-all t]

1620 - ["Toggle All Marks" git-toggle-all-marks t]

1621 - ["Hide Handled Files" git-remove-handled t]

1622 - "--------"

1623 - ["Show Uptodate Files" git-toggle-show-uptodate :style toggle :selected git-show-uptodate]

1624 - ["Show Ignored Files" git-toggle-show-ignored :style toggle :selected git-show-ignored]

1625 - ["Show Unknown Files" git-toggle-show-unknown :style toggle :selected git-show-unknown]

1626 - "--------"

1627 - ["Quit" git-status-quit t])))

1628 -

1629 -

1630 -;; git mode should only run in the *git status* buffer

1631 -(put 'git-status-mode 'mode-class 'special)

1632 -

1633 -(defun git-status-mode ()

1634 - "Major mode for interacting with Git.

1635 -Commands:

1636 -\\{git-status-mode-map}"

1637 - (kill-all-local-variables)

1638 - (buffer-disable-undo)

1639 - (setq mode-name "git status"

1640 - major-mode 'git-status-mode

1641 - goal-column 17

1642 - buffer-read-only t)

1643 - (use-local-map git-status-mode-map)

1644 - (let ((buffer-read-only nil))

1645 - (erase-buffer)

1646 - (let ((status (ewoc-create 'git-fileinfo-prettyprint "" "")))

1647 - (set (make-local-variable 'git-status) status))

1648 - (set (make-local-variable 'list-buffers-directory) default-directory)

1649 - (make-local-variable 'git-show-uptodate)

1650 - (make-local-variable 'git-show-ignored)

1651 - (make-local-variable 'git-show-unknown)

1652 - (run-hooks 'git-status-mode-hook)))

1653 -

1654 -(defun git-find-status-buffer (dir)

1655 - "Find the git status buffer handling a specified directory."

1656 - (let ((list (buffer-list))

1657 - (fulldir (expand-file-name dir))

1658 - found)

1659 - (while (and list (not found))

1660 - (let ((buffer (car list)))

1661 - (with-current-buffer buffer

1662 - (when (and list-buffers-directory

1663 - (string-equal fulldir (expand-file-name list-buffers-directory))

1664 - (eq major-mode 'git-status-mode))

1665 - (setq found buffer))))

1666 - (setq list (cdr list)))

1667 - found))

1668 -

1669 -(defun git-status (dir)

1670 - "Entry point into git-status mode."

1671 - (interactive "DSelect directory: ")

1672 - (setq dir (git-get-top-dir dir))

1673 - (if (file-exists-p (concat (file-name-as-directory dir) ".git"))

1674 - (let ((buffer (or (and git-reuse-status-buffer (git-find-status-buffer dir))

1675 - (create-file-buffer (expand-file-name "*git-status*" dir)))))

1676 - (switch-to-buffer buffer)

1677 - (cd dir)

1678 - (git-status-mode)

1679 - (git-refresh-status)

1680 - (goto-char (point-min))

1681 - (add-hook 'after-save-hook 'git-update-saved-file))

1682 - (message "%s is not a git working tree." dir)))

1683 -

1684 -(defun git-update-saved-file ()

1685 - "Update the corresponding git-status buffer when a file is saved.

1686 -Meant to be used in `after-save-hook'."

1687 - (let* ((file (expand-file-name buffer-file-name))

1688 - (dir (condition-case nil (git-get-top-dir (file-name-directory file)) (error nil)))

1689 - (buffer (and dir (git-find-status-buffer dir))))

1690 - (when buffer

1691 - (with-current-buffer buffer

1692 - (let ((filename (file-relative-name file dir)))

1693 - ; skip files located inside the .git directory

1694 - (unless (string-match "^\\.git/" filename)

1695 - (git-call-process nil "add" "--refresh" "--" filename)

1696 - (git-update-status-files (list filename))))))))

1697 -

1698 -(defun git-help ()

1699 - "Display help for Git mode."

1700 - (interactive)

1701 - (describe-function 'git-status-mode))

1702 -

1703 -(provide 'git)

1704 -;;; git.el ends here

1 +(error "git.el no longer ships with git. It's recommended to

2 +replace its use with Magit, or simply delete references to git.el

3 +in your initialization file(s). See contrib/emacs/README in git's

4 +sources (https://github.com/git/git/blob/master/contrib/emacs/README)

5 +for suggested alternatives and for why this happened. Emacs's own

6 +VC mode and Magit are viable alternatives.")