![[tokkee]](http://tokkee.org/images/avatar.png){kind=avatar}
diff --git a/contrib/emacs/git.el b/contrib/emacs/git.el
index 28a4899a0a46d67978280a1d0657f4b2b98be1d7..c9268234a5b7342849a7a711e0bb0c6e4f003754 100644 (file)
--- a/contrib/emacs/git.el
+++ b/contrib/emacs/git.el
;;
;; TODO
;; - portability to XEmacs
-;; - better handling of subprocess errors
;; - diff against other branch
;; - renaming files from the status buffer
;; - creating tags
(defun git-call-process-env (buffer env &rest args)
"Wrapper for call-process that sets environment strings."
- (if env
- (apply #'call-process "env" nil buffer nil
- (append (git-get-env-strings env) (list "git") args))
+ (let ((process-environment (append (git-get-env-strings env)
+ process-environment)))
(apply #'call-process "git" nil buffer nil args)))
+(defun git-call-process-display-error (&rest args)
+ "Wrapper for call-process that displays error messages."
+ (let* ((dir default-directory)
+ (buffer (get-buffer-create "*Git Command Output*"))
+ (ok (with-current-buffer buffer
+ (let ((default-directory dir)
+ (buffer-read-only nil))
+ (erase-buffer)
+ (eq 0 (apply 'call-process "git" nil (list buffer t) nil args))))))
+ (unless ok (display-message-or-buffer buffer))
+ ok))
+
(defun git-call-process-env-string (env &rest args)
"Wrapper for call-process that sets environment strings,
-and returns the process output as a string."
+and returns the process output as a string, or nil if the git failed."
(with-temp-buffer
(and (eq 0 (apply #' git-call-process-env t env args))
(buffer-string))))
(when reason
(push reason args)
(push "-m" args))
- (eq 0 (apply #'git-call-process-env nil nil "update-ref" args))))
+ (apply 'git-call-process-display-error "update-ref" args)))
(defun git-read-tree (tree &optional index-file)
"Read a tree into the index file."
"Set the state of a file info."
(unless (eq (git-fileinfo->state info) state)
(setf (git-fileinfo->state info) state
- (git-fileinfo->old-perm info) 0
- (git-fileinfo->new-perm info) 0
+ (git-fileinfo->new-perm info) (git-fileinfo->old-perm info)
(git-fileinfo->rename-state info) nil
(git-fileinfo->orig-name info) nil
(git-fileinfo->needs-refresh info) t)))
(?A 'added)
(?D 'deleted)
(?U 'unmerged)
+ (?T 'modified)
(t nil)))
(defun git-status-code-as-string (code)
('ignored (propertize "Ignored " 'face 'git-ignored-face))
(t "? ")))
+(defun git-file-type-as-string (old-perm new-perm)
+ "Return a string describing the file type based on its permissions."
+ (let* ((old-type (lsh (or old-perm 0) -9))
+ (new-type (lsh (or new-perm 0) -9))
+ (str (case new-type
+ (?\100 ;; file
+ (case old-type
+ (?\100 nil)
+ (?\120 " (type change symlink -> file)")
+ (?\160 " (type change subproject -> file)")))
+ (?\120 ;; symlink
+ (case old-type
+ (?\100 " (type change file -> symlink)")
+ (?\160 " (type change subproject -> symlink)")
+ (t " (symlink)")))
+ (?\160 ;; subproject
+ (case old-type
+ (?\100 " (type change file -> subproject)")
+ (?\120 " (type change symlink -> subproject)")
+ (t " (subproject)")))
+ (?\110 nil) ;; directory (internal, not a real git state)
+ (?\000 ;; deleted or unknown
+ (case old-type
+ (?\120 " (symlink)")
+ (?\160 " (subproject)")))
+ (t (format " (unknown type %o)" new-type)))))
+ (cond (str (propertize str 'face 'git-status-face))
+ ((eq new-type ?\110) "/")
+ (t ""))))
+
(defun git-rename-as-string (info)
"Return a string describing the copy or rename associated with INFO, or an empty string if none."
(let ((state (git-fileinfo->rename-state info)))
(defun git-fileinfo-prettyprint (info)
"Pretty-printer for the git-fileinfo structure."
- (insert (concat " " (if (git-fileinfo->marked info) (propertize "*" 'face 'git-mark-face) " ")
- " " (git-status-code-as-string (git-fileinfo->state info))
- " " (git-permissions-as-string (git-fileinfo->old-perm info) (git-fileinfo->new-perm info))
- " " (git-escape-file-name (git-fileinfo->name info))
- (git-rename-as-string info))))
+ (let ((old-perm (git-fileinfo->old-perm info))
+ (new-perm (git-fileinfo->new-perm info)))
+ (insert (concat " " (if (git-fileinfo->marked info) (propertize "*" 'face 'git-mark-face) " ")
+ " " (git-status-code-as-string (git-fileinfo->state info))
+ " " (git-permissions-as-string old-perm new-perm)
+ " " (git-escape-file-name (git-fileinfo->name info))
+ (git-file-type-as-string old-perm new-perm)
+ (git-rename-as-string info)))))
(defun git-insert-info-list (status infolist)
"Insert a list of file infos in the status buffer, replacing existing ones if any."
(let ((info (pop infolist))
(node (ewoc-nth status 0)))
(while info
- (setf (git-fileinfo->needs-refresh info) t)
(cond ((not node)
- (ewoc-enter-last status info)
+ (setq node (ewoc-enter-last status info))
(setq info (pop infolist)))
((string-lessp (git-fileinfo->name (ewoc-data node))
(git-fileinfo->name info))
(git-fileinfo->name info))
;; preserve the marked flag
(setf (git-fileinfo->marked info) (git-fileinfo->marked (ewoc-data node)))
+ (setf (git-fileinfo->needs-refresh info) t)
(setf (ewoc-data node) info)
(setq info (pop infolist)))
(t
- (ewoc-enter-before status node info)
+ (setq node (ewoc-enter-before status node info))
(setq info (pop infolist)))))))
(defun git-run-diff-index (status files)
"Run git-diff-index on FILES and parse the results into STATUS.
Return the list of files that haven't been handled."
- (let (infolist)
+ (let ((remaining (copy-sequence files))
+ infolist)
(with-temp-buffer
(apply #'git-call-process-env t nil "diff-index" "-z" "-M" "HEAD" "--" files)
(goto-char (point-min))
(while (re-search-forward
- ":\\([0-7]\\{6\\}\\) \\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\(\\([ADMU]\\)\0\\([^\0]+\\)\\|\\([CR]\\)[0-9]*\0\\([^\0]+\\)\0\\([^\0]+\\)\\)\0"
+ ":\\([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"
nil t 1)
(let ((old-perm (string-to-number (match-string 1) 8))
(new-perm (string-to-number (match-string 2) 8))
(push (git-create-fileinfo 'deleted name 0 0 'rename new-name) infolist)
(push (git-create-fileinfo 'added new-name old-perm new-perm 'rename name) infolist))
(push (git-create-fileinfo (git-state-code state) name old-perm new-perm) infolist))
- (setq files (delete name files))
- (when new-name (setq files (delete new-name files))))))
+ (setq remaining (delete name remaining))
+ (when new-name (setq remaining (delete new-name remaining))))))
(git-insert-info-list status infolist)
- files))
+ remaining))
(defun git-find-status-file (status file)
"Find a given file in the status ewoc and return its node."
(with-temp-buffer
(apply #'git-call-process-env t nil "ls-files" "-z" (append options (list "--") files))
(goto-char (point-min))
- (while (re-search-forward "\\([^\0]*\\)\0" nil t 1)
+ (while (re-search-forward "\\([^\0]*?\\)\\(/?\\)\0" nil t 1)
(let ((name (match-string 1)))
- (push (git-create-fileinfo default-state name) infolist)
+ (push (git-create-fileinfo default-state name 0
+ (if (string-equal "/" (match-string 2)) (lsh ?\110 9) 0))
+ infolist)
(setq files (delete name files)))))
(git-insert-info-list status infolist)
files))
+(defun git-run-ls-files-cached (status files default-state)
+ "Run git-ls-files -c on FILES and parse the results into STATUS.
+Return the list of files that haven't been handled."
+ (let ((remaining (copy-sequence files))
+ infolist)
+ (with-temp-buffer
+ (apply #'git-call-process-env t nil "ls-files" "-z" "-s" "-c" "--" files)
+ (goto-char (point-min))
+ (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
+ (let* ((new-perm (string-to-number (match-string 1) 8))
+ (old-perm (if (eq default-state 'added) 0 new-perm))
+ (name (match-string 2)))
+ (push (git-create-fileinfo default-state name old-perm new-perm) infolist)
+ (setq remaining (delete name remaining)))))
+ (git-insert-info-list status infolist)
+ remaining))
+
(defun git-run-ls-unmerged (status files)
"Run git-ls-files -u on FILES and parse the results into STATUS."
(with-temp-buffer
(defun git-run-ls-files-with-excludes (status files default-state &rest options)
"Run git-ls-files on FILES with appropriate --exclude-from options."
(let ((exclude-files (git-get-exclude-files)))
- (apply #'git-run-ls-files status files default-state
+ (apply #'git-run-ls-files status files default-state "--directory" "--no-empty-directory"
(concat "--exclude-per-directory=" git-per-dir-ignore-file)
(append options (mapcar (lambda (f) (concat "--exclude-from=" f)) exclude-files)))))
(defun git-update-status-files (files &optional default-state)
"Update the status of FILES from the index."
(unless git-status (error "Not in git-status buffer."))
- (unless files
- (when git-show-uptodate (git-run-ls-files git-status nil 'uptodate "-c")))
+ (when (or git-show-uptodate files)
+ (git-run-ls-files-cached git-status files 'uptodate))
(let* ((remaining-files
(if (git-empty-db-p) ; we need some special handling for an empty db
- (git-run-ls-files git-status files 'added "-c")
+ (git-run-ls-files-cached git-status files 'added)
(git-run-diff-index git-status files))))
(git-run-ls-unmerged git-status files)
(when (or remaining-files (and git-show-unknown (not files)))
(git-refresh-files)
(git-refresh-ewoc-hf git-status)))
+(defun git-mark-files (status files)
+ "Mark all the specified FILES, and unmark the others."
+ (setq files (sort files #'string-lessp))
+ (let ((file (and files (pop files)))
+ (node (ewoc-nth status 0)))
+ (while node
+ (let ((info (ewoc-data node)))
+ (if (and file (string-equal (git-fileinfo->name info) file))
+ (progn
+ (unless (git-fileinfo->marked info)
+ (setf (git-fileinfo->marked info) t)
+ (setf (git-fileinfo->needs-refresh info) t))
+ (setq file (pop files))
+ (setq node (ewoc-next status node)))
+ (when (git-fileinfo->marked info)
+ (setf (git-fileinfo->marked info) nil)
+ (setf (git-fileinfo->needs-refresh info) t))
+ (if (and file (string-lessp file (git-fileinfo->name info)))
+ (setq file (pop files))
+ (setq node (ewoc-next status node))))))))
+
(defun git-marked-files ()
"Return a list of all marked files, or if none a list containing just the file at cursor position."
(unless git-status (error "Not in git-status buffer."))
(if (or (not (string-equal tree head-tree))
(yes-or-no-p "The tree was not modified, do you really want to perform an empty commit? "))
(let ((commit (git-commit-tree buffer tree head)))
- (condition-case nil (delete-file ".git/MERGE_HEAD") (error nil))
- (condition-case nil (delete-file ".git/MERGE_MSG") (error nil))
- (with-current-buffer buffer (erase-buffer))
- (dolist (info files) (git-set-fileinfo-state info 'uptodate))
- (git-call-process-env nil nil "rerere")
- (git-call-process-env nil nil "gc" "--auto")
- (git-refresh-files)
- (git-refresh-ewoc-hf git-status)
- (message "Committed %s." commit)
- (git-run-hook "post-commit" nil))
+ (when commit
+ (condition-case nil (delete-file ".git/MERGE_HEAD") (error nil))
+ (condition-case nil (delete-file ".git/MERGE_MSG") (error nil))
+ (with-current-buffer buffer (erase-buffer))
+ (git-update-status-files (git-get-filenames files) 'uptodate)
+ (git-call-process-env nil nil "rerere")
+ (git-call-process-env nil nil "gc" "--auto")
+ (git-refresh-files)
+ (git-refresh-ewoc-hf git-status)
+ (message "Committed %s." commit)
+ (git-run-hook "post-commit" nil)))
(message "Commit aborted."))))
(message "No files to commit.")))
(delete-file index-file))))))
"Add marked file(s) to the index cache."
(interactive)
(let ((files (git-get-filenames (git-marked-files-state 'unknown 'ignored))))
+ ;; FIXME: add support for directories
(unless files
(push (file-relative-name (read-file-name "File to add: " nil nil t)) files))
- (apply #'git-call-process-env nil nil "update-index" "--add" "--" files)
- (git-update-status-files files 'uptodate)
- (git-success-message "Added" files)))
+ (when (apply 'git-call-process-display-error "update-index" "--add" "--" files)
+ (git-update-status-files files 'uptodate)
+ (git-success-message "Added" files))))
(defun git-ignore-file ()
"Add marked file(s) to the ignore list."
(format "Remove %d file%s? " (length files) (if (> (length files) 1) "s" "")))
(progn
(dolist (name files)
- (when (file-exists-p name) (delete-file name)))
- (apply #'git-call-process-env nil nil "update-index" "--remove" "--" files)
- (git-update-status-files files nil)
- (git-success-message "Removed" files))
+ (ignore-errors
+ (if (file-directory-p name)
+ (delete-directory name)
+ (delete-file name))))
+ (when (apply 'git-call-process-display-error "update-index" "--remove" "--" files)
+ (git-update-status-files files nil)
+ (git-success-message "Removed" files)))
(message "Aborting"))))
(defun git-revert-file ()
"Revert changes to the marked file(s)."
(interactive)
- (let ((files (git-marked-files))
+ (let ((files (git-marked-files-state 'added 'deleted 'modified 'unmerged))
added modified)
(when (and files
(yes-or-no-p
('deleted (push (git-fileinfo->name info) modified))
('unmerged (push (git-fileinfo->name info) modified))
('modified (push (git-fileinfo->name info) modified))))
- (when added
- (apply #'git-call-process-env nil nil "update-index" "--force-remove" "--" added))
- (when modified
- (apply #'git-call-process-env nil nil "checkout" "HEAD" modified))
- (git-update-status-files (append added modified) 'uptodate)
- (git-success-message "Reverted" (git-get-filenames files)))))
+ ;; check if a buffer contains one of the files and isn't saved
+ (dolist (file modified)
+ (let ((buffer (get-file-buffer file)))
+ (when (and buffer (buffer-modified-p buffer))
+ (error "Buffer %s is modified. Please kill or save modified buffers before reverting." (buffer-name buffer)))))
+ (let ((ok (and
+ (or (not added)
+ (apply 'git-call-process-display-error "update-index" "--force-remove" "--" added))
+ (or (not modified)
+ (apply 'git-call-process-display-error "checkout" "HEAD" modified)))))
+ (git-update-status-files (append added modified) 'uptodate)
+ (when ok
+ (dolist (file modified)
+ (let ((buffer (get-file-buffer file)))
+ (when buffer (with-current-buffer buffer (revert-buffer t t t)))))
+ (git-success-message "Reverted" (git-get-filenames files)))))))
(defun git-resolve-file ()
"Resolve conflicts in marked file(s)."
(interactive)
(let ((files (git-get-filenames (git-marked-files-state 'unmerged))))
(when files
- (apply #'git-call-process-env nil nil "update-index" "--" files)
- (git-update-status-files files 'uptodate)
- (git-success-message "Resolved" files))))
+ (when (apply 'git-call-process-display-error "update-index" "--" files)
+ (git-update-status-files files 'uptodate)
+ (git-success-message "Resolved" files)))))
(defun git-remove-handled ()
"Remove handled files from the status list."
(message "Inserting unknown files...done"))
(git-remove-handled)))
+(defun git-expand-directory (info)
+ "Expand the directory represented by INFO to list its files."
+ (when (eq (lsh (git-fileinfo->new-perm info) -9) ?\110)
+ (let ((dir (git-fileinfo->name info)))
+ (git-set-filenames-state git-status (list dir) nil)
+ (git-run-ls-files-with-excludes git-status (list (concat dir "/")) 'unknown "-o")
+ (git-refresh-files)
+ (git-refresh-ewoc-hf git-status)
+ t)))
+
(defun git-setup-diff-buffer (buffer)
"Setup a buffer for displaying a diff."
(let ((dir default-directory))
(setq default-directory dir)
(setq buffer-read-only t)))
(display-buffer buffer)
- (shrink-window-if-larger-than-buffer))
+ ; shrink window only if it displays the status buffer
+ (when (eq (window-buffer) (current-buffer))
+ (shrink-window-if-larger-than-buffer)))
(defun git-diff-file ()
"Diff the marked file(s) against HEAD."
(with-current-buffer log-edit-parent-buffer
(git-get-filenames (git-marked-files-state 'added 'deleted 'modified))))
+(defun git-log-edit-diff ()
+ "Run a diff of the current files being committed from a log-edit buffer."
+ (with-current-buffer log-edit-parent-buffer
+ (git-diff-file)))
+
(defun git-append-sign-off (name email)
"Append a Signed-off-by entry to the current buffer, avoiding duplicates."
(let ((sign-off (format "Signed-off-by: %s <%s>" name email))
(goto-char (point-min))
(when (re-search-forward "\n+\\'" nil t)
(replace-match "\n" t t))
- (when sign-off (git-append-sign-off committer-name committer-email)))))
+ (when sign-off (git-append-sign-off committer-name committer-email)))
+ buffer))
(defun git-commit-file ()
"Commit the marked file(s), asking for a commit message."
(when (re-search-forward "^Date: \\(.*\\)$" nil t)
(setq date (match-string 1)))))
(git-setup-log-buffer buffer author-name author-email subject date))
- (log-edit #'git-do-commit nil #'git-log-edit-files buffer)
+ (if (boundp 'log-edit-diff-function)
+ (log-edit 'git-do-commit nil '((log-edit-listfun . git-log-edit-files)
+ (log-edit-diff-function . git-log-edit-diff)) buffer)
+ (log-edit 'git-do-commit nil 'git-log-edit-files buffer))
(setq font-lock-keywords (font-lock-compile-keywords git-log-edit-font-lock-keywords))
(setq buffer-file-coding-system coding-system)
(re-search-forward (regexp-quote (concat git-log-msg-separator "\n")) nil t))))
+(defun git-setup-commit-buffer (commit)
+ "Setup the commit buffer with the contents of COMMIT."
+ (let (author-name author-email subject date msg)
+ (with-temp-buffer
+ (let ((coding-system (git-get-logoutput-coding-system)))
+ (git-call-process-env t nil "log" "-1" commit)
+ (goto-char (point-min))
+ (when (re-search-forward "^Author: *\\(.*\\) <\\(.*\\)>$" nil t)
+ (setq author-name (match-string 1))
+ (setq author-email (match-string 2)))
+ (when (re-search-forward "^Date: *\\(.*\\)$" nil t)
+ (setq date (match-string 1)))
+ (while (re-search-forward "^ \\(.*\\)$" nil t)
+ (push (match-string 1) msg))
+ (setq msg (nreverse msg))
+ (setq subject (pop msg))
+ (while (and msg (zerop (length (car msg))) (pop msg)))))
+ (git-setup-log-buffer (get-buffer-create "*git-commit*")
+ author-name author-email subject date
+ (mapconcat #'identity msg "\n"))))
+
+(defun git-get-commit-files (commit)
+ "Retrieve the list of files modified by COMMIT."
+ (let (files)
+ (with-temp-buffer
+ (git-call-process-env t nil "diff-tree" "-r" "-z" "--name-only" "--no-commit-id" commit)
+ (goto-char (point-min))
+ (while (re-search-forward "\\([^\0]*\\)\0" nil t 1)
+ (push (match-string 1) files)))
+ files))
+
+(defun git-amend-commit ()
+ "Undo the last commit on HEAD, and set things up to commit an
+amended version of it."
+ (interactive)
+ (unless git-status (error "Not in git-status buffer."))
+ (when (git-empty-db-p) (error "No commit to amend."))
+ (let* ((commit (git-rev-parse "HEAD"))
+ (files (git-get-commit-files commit)))
+ (when (git-call-process-display-error "reset" "--soft" "HEAD^")
+ (git-update-status-files (copy-sequence files) 'uptodate)
+ (git-mark-files git-status files)
+ (git-refresh-files)
+ (git-setup-commit-buffer commit)
+ (git-commit-file))))
+
(defun git-find-file ()
"Visit the current file in its own buffer."
(interactive)
(unless git-status (error "Not in git-status buffer."))
(let ((info (ewoc-data (ewoc-locate git-status))))
- (find-file (git-fileinfo->name info))
- (when (eq 'unmerged (git-fileinfo->state info))
- (smerge-mode 1))))
+ (unless (git-expand-directory info)
+ (find-file (git-fileinfo->name info))
+ (when (eq 'unmerged (git-fileinfo->state info))
+ (smerge-mode 1)))))
(defun git-find-file-other-window ()
"Visit the current file in its own buffer in another window."
(unless git-status-mode-map
(let ((map (make-keymap))
+ (commit-map (make-sparse-keymap))
(diff-map (make-sparse-keymap))
(toggle-map (make-sparse-keymap)))
(suppress-keymap map)
(define-key map " " 'git-next-file)
(define-key map "a" 'git-add-file)
(define-key map "c" 'git-commit-file)
+ (define-key map "\C-c" commit-map)
(define-key map "d" diff-map)
(define-key map "=" 'git-diff-file)
(define-key map "f" 'git-find-file)
(define-key map "x" 'git-remove-handled)
(define-key map "\C-?" 'git-unmark-file-up)
(define-key map "\M-\C-?" 'git-unmark-all)
+ ; the commit submap
+ (define-key commit-map "\C-a" 'git-amend-commit)
; the diff submap
(define-key diff-map "b" 'git-diff-file-base)
(define-key diff-map "c" 'git-diff-file-combined)
(with-current-buffer buffer
(when (and list-buffers-directory
(string-equal fulldir (expand-file-name list-buffers-directory))
- (string-match "\\*git-status\\*$" (buffer-name buffer)))
+ (eq major-mode 'git-status-mode))
(setq found buffer))))
(setq list (cdr list)))
found))