![[tokkee]](http://tokkee.org/images/avatar.png){kind=avatar}
diff --git a/contrib/emacs/git.el b/contrib/emacs/git.el
index 2d77fd47ece21af7b79b3e5806521e208d5d92b0..4286d160a02bdbeff272cc306ab01b85b87b8cbe 100644 (file)
--- a/contrib/emacs/git.el
+++ b/contrib/emacs/git.el
;; TODO
;; - portability to XEmacs
;; - better handling of subprocess errors
-;; - hook into file save (after-save-hook)
;; - diff against other branch
;; - renaming files from the status buffer
;; - creating tags
(message "Running git %s...done" (car args))
buffer))
-(defun git-run-command (buffer env &rest args)
- (message "Running git %s..." (car args))
- (apply #'git-call-process-env buffer env args)
- (message "Running git %s...done" (car args)))
-
(defun git-run-command-region (buffer start end env &rest args)
"Run a git command with specified buffer region as input."
- (message "Running git %s..." (car args))
(unless (eq 0 (if env
(git-run-process-region
buffer start end "env"
(append (git-get-env-strings env) (list "git") args))
(git-run-process-region
buffer start end "git" args)))
- (error "Failed to run \"git %s\":\n%s" (mapconcat (lambda (x) x) args " ") (buffer-string)))
- (message "Running git %s...done" (car args)))
+ (error "Failed to run \"git %s\":\n%s" (mapconcat (lambda (x) x) args " ") (buffer-string))))
(defun git-run-hook (hook env &rest args)
"Run a git hook and display its output if any."
"\"")
name))
+(defun git-success-message (text files)
+ "Print a success message after having handled FILES."
+ (let ((n (length files)))
+ (if (equal n 1)
+ (message "%s %s" text (car files))
+ (message "%s %d files" text n))))
+
(defun git-get-top-dir (dir)
"Retrieve the top-level directory of a git tree."
(let ((cdup (with-output-to-string
(sort-lines nil (point-min) (point-max))
(save-buffer))
(when created
- (git-run-command nil nil "update-index" "--add" "--" (file-relative-name ignore-name)))
+ (git-call-process-env nil nil "update-index" "--add" "--" (file-relative-name ignore-name)))
(git-update-status-files (list (file-relative-name ignore-name)) 'unknown)))
; propertize definition for XEmacs, stolen from erc-compat
"Remove everything from the status list."
(ewoc-filter status (lambda (info) nil)))
-(defun git-set-files-state (files state)
- "Set the state of a list of files."
- (dolist (info files)
- (unless (eq (git-fileinfo->state info) state)
- (setf (git-fileinfo->state info) state)
- (setf (git-fileinfo->rename-state info) nil)
- (setf (git-fileinfo->orig-name info) nil)
- (setf (git-fileinfo->needs-refresh info) t))))
-
-(defun git-set-filenames-state (status files state)
- "Set the state of a list of named files."
+(defun git-set-fileinfo-state (info state)
+ "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->rename-state info) nil
+ (git-fileinfo->orig-name info) nil
+ (git-fileinfo->needs-refresh info) t)))
+
+(defun git-status-filenames-map (status func files &rest args)
+ "Apply FUNC to the status files names in the FILES list."
(when files
(setq files (sort files #'string-lessp))
(let ((file (pop files))
(node (ewoc-nth status 0)))
(while (and file node)
(let ((info (ewoc-data node)))
- (cond ((string-lessp (git-fileinfo->name info) file)
- (setq node (ewoc-next status node)))
- ((string-equal (git-fileinfo->name info) file)
- (unless (eq (git-fileinfo->state info) state)
- (setf (git-fileinfo->state info) state)
- (setf (git-fileinfo->rename-state info) nil)
- (setf (git-fileinfo->orig-name info) nil)
- (setf (git-fileinfo->needs-refresh info) t))
- (setq file (pop files)))
- (t (setq file (pop files)))))))
+ (if (string-lessp (git-fileinfo->name info) file)
+ (setq node (ewoc-next status node))
+ (if (string-equal (git-fileinfo->name info) file)
+ (apply func info args))
+ (setq file (pop files))))))))
+
+(defun git-set-filenames-state (status files state)
+ "Set the state of a list of named files."
+ (when files
+ (git-status-filenames-map status #'git-set-fileinfo-state files state)
(unless state ;; delete files whose state has been set to nil
(ewoc-filter status (lambda (info) (git-fileinfo->state info))))))
Return the list of files that haven't been handled."
(let (infolist)
(with-temp-buffer
- (apply #'git-run-command t nil "diff-index" "-z" "-M" "HEAD" "--" files)
+ (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"
Return the list of files that haven't been handled."
(let (infolist)
(with-temp-buffer
- (apply #'git-run-command t nil "ls-files" "-z" (append options (list "--") files))
+ (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)
(let ((name (match-string 1)))
(defun git-run-ls-unmerged (status files)
"Run git-ls-files -u on FILES and parse the results into STATUS."
(with-temp-buffer
- (apply #'git-run-command t nil "ls-files" "-z" "-u" "--" files)
+ (apply #'git-call-process-env t nil "ls-files" "-z" "-u" "--" files)
(goto-char (point-min))
(let (unmerged-files)
(while (re-search-forward "[0-7]\\{6\\} [0-9a-f]\\{40\\} [123]\t\\([^\0]+\\)\0" nil t)
('deleted (push info deleted))
('modified (push info modified))))
(when added
- (apply #'git-run-command nil env "update-index" "--add" "--" (git-get-filenames added)))
+ (apply #'git-call-process-env nil env "update-index" "--add" "--" (git-get-filenames added)))
(when deleted
- (apply #'git-run-command nil env "update-index" "--remove" "--" (git-get-filenames deleted)))
+ (apply #'git-call-process-env nil env "update-index" "--remove" "--" (git-get-filenames deleted)))
(when modified
- (apply #'git-run-command nil env "update-index" "--" (git-get-filenames modified)))))
+ (apply #'git-call-process-env nil env "update-index" "--" (git-get-filenames modified)))))
(defun git-run-pre-commit-hook ()
"Run the pre-commit hook if any."
head-tree (git-rev-parse "HEAD^{tree}")))
(if files
(progn
+ (message "Running git commit...")
(git-read-tree head-tree index-file)
(git-update-index nil files) ;update both the default index
(git-update-index index-file files) ;and the temporary one
(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-set-files-state files 'uptodate)
- (git-run-command nil nil "rerere")
+ (dolist (info files) (git-set-fileinfo-state info 'uptodate))
+ (git-call-process-env nil nil "rerere")
(git-refresh-files)
(git-refresh-ewoc-hf git-status)
(message "Committed %s." commit)
(let ((files (git-get-filenames (git-marked-files-state 'unknown 'ignored))))
(unless files
(push (file-relative-name (read-file-name "File to add: " nil nil t)) files))
- (apply #'git-run-command nil nil "update-index" "--add" "--" files)
- (git-update-status-files files 'uptodate)))
+ (apply #'git-call-process-env nil nil "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."
(unless files
(push (file-relative-name (read-file-name "File to ignore: " nil nil t)) files))
(dolist (f files) (git-append-to-ignore f))
- (git-update-status-files files 'ignored)))
+ (git-update-status-files files 'ignored)
+ (git-success-message "Ignored" files)))
(defun git-remove-file ()
"Remove the marked file(s)."
(progn
(dolist (name files)
(when (file-exists-p name) (delete-file name)))
- (apply #'git-run-command nil nil "update-index" "--remove" "--" files)
- (git-update-status-files files nil))
+ (apply #'git-call-process-env nil nil "update-index" "--remove" "--" files)
+ (git-update-status-files files nil)
+ (git-success-message "Removed" files))
(message "Aborting"))))
(defun git-revert-file ()
('unmerged (push (git-fileinfo->name info) modified))
('modified (push (git-fileinfo->name info) modified))))
(when added
- (apply #'git-run-command nil nil "update-index" "--force-remove" "--" added))
+ (apply #'git-call-process-env nil nil "update-index" "--force-remove" "--" added))
(when modified
- (apply #'git-run-command nil nil "checkout" "HEAD" modified))
- (git-update-status-files (append added modified) 'uptodate))))
+ (apply #'git-call-process-env nil nil "checkout" "HEAD" modified))
+ (git-update-status-files (append added modified) 'uptodate)
+ (git-success-message "Reverted" 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-run-command nil nil "update-index" "--" files)
- (git-update-status-files files 'uptodate))))
+ (apply #'git-call-process-env nil nil "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."
(interactive)
(if (setq git-show-ignored (not git-show-ignored))
(progn
+ (message "Inserting ignored files...")
(git-run-ls-files-with-excludes git-status nil 'ignored "-o" "-i")
(git-refresh-files)
- (git-refresh-ewoc-hf git-status))
+ (git-refresh-ewoc-hf git-status)
+ (message "Inserting ignored files...done"))
(git-remove-handled)))
(defun git-toggle-show-unknown ()
(interactive)
(if (setq git-show-unknown (not git-show-unknown))
(progn
+ (message "Inserting unknown files...")
(git-run-ls-files-with-excludes git-status nil 'unknown "-o")
(git-refresh-files)
- (git-refresh-ewoc-hf git-status))
+ (git-refresh-ewoc-hf git-status)
+ (message "Inserting unknown files...done"))
(git-remove-handled)))
(defun git-setup-diff-buffer (buffer)
(interactive)
(let* ((status git-status)
(pos (ewoc-locate status))
+ (marked-files (git-get-filenames (ewoc-collect status (lambda (info) (git-fileinfo->marked info)))))
(cur-name (and pos (git-fileinfo->name (ewoc-data pos)))))
(unless status (error "Not in git-status buffer."))
- (git-run-command nil nil "update-index" "--refresh")
+ (message "Refreshing git status...")
+ (git-call-process-env nil nil "update-index" "--refresh")
(git-clear-status status)
(git-update-status-files nil)
+ ; restore file marks
+ (when marked-files
+ (git-status-filenames-map status
+ (lambda (info)
+ (setf (git-fileinfo->marked info) t)
+ (setf (git-fileinfo->needs-refresh info) t))
+ marked-files)
+ (git-refresh-files))
; move point to the current file name if any
+ (message "Refreshing git status...done")
(let ((node (and cur-name (git-find-status-file status cur-name))))
(when node (ewoc-goto-node status node)))))
(cd dir)
(git-status-mode)
(git-refresh-status)
- (goto-char (point-min)))
+ (goto-char (point-min))
+ (add-hook 'after-save-hook 'git-update-saved-file))
(message "%s is not a git working tree." dir)))
+(defun git-update-saved-file ()
+ "Update the corresponding git-status buffer when a file is saved.
+Meant to be used in `after-save-hook'."
+ (let* ((file (expand-file-name buffer-file-name))
+ (dir (condition-case nil (git-get-top-dir (file-name-directory file))))
+ (buffer (and dir (git-find-status-buffer dir))))
+ (when buffer
+ (with-current-buffer buffer
+ (let ((filename (file-relative-name file dir)))
+ ; skip files located inside the .git directory
+ (unless (string-match "^\\.git/" filename)
+ (git-call-process-env nil nil "add" "--refresh" "--" filename)
+ (git-update-status-files (list filename) 'uptodate)))))))
+
(defun git-help ()
"Display help for Git mode."
(interactive)