(cd dir)
(unless (eq 0 (call-process "git" nil t nil
"rev-parse" "--show-cdup"))
- (error "cannot find top-level git tree for %s." dir))))))
+ (error "Cannot find top-level git tree for %s" dir))))))
(expand-file-name (concat (file-name-as-directory dir)
(car (split-string cdup "\n")))))))
(apply 'call-process "git" nil standard-output nil args)
(message "Running git %s...done" msgcmd)))
+(defun stgit-run-git-silent (&rest args)
+ (apply 'call-process "git" nil standard-output nil args))
+
(defun stgit-reload ()
"Update the contents of the StGit buffer."
(interactive)
"The face used for unapplied patch names"
:group 'stgit)
+(defface stgit-modified-file-face
+ '((((class color) (background light)) (:foreground "purple"))
+ (((class color) (background dark)) (:foreground "salmon")))
+ "StGit mode face used for modified file status"
+ :group 'stgit)
+
+(defface stgit-unmerged-file-face
+ '((((class color) (background light)) (:foreground "red" :bold t))
+ (((class color) (background dark)) (:foreground "red" :bold t)))
+ "StGit mode face used for unmerged file status"
+ :group 'stgit)
+
+(defface stgit-unknown-file-face
+ '((((class color) (background light)) (:foreground "goldenrod" :bold t))
+ (((class color) (background dark)) (:foreground "goldenrod" :bold t)))
+ "StGit mode face used for unknown file status"
+ :group 'stgit)
+
+(defface stgit-file-permission-face
+ '((((class color) (background light)) (:foreground "green" :bold t))
+ (((class color) (background dark)) (:foreground "green" :bold t)))
+ "StGit mode face used for permission changes."
+ :group 'stgit)
+
+(defcustom stgit-expand-find-copies-harder
+ nil
+ "Try harder to find copied files when listing patches.
+
+When not nil, runs git diff-tree with the --find-copies-harder
+flag, which reduces performance."
+ :type 'boolean
+ :group 'stgit)
+
+(defconst stgit-file-status-code-strings
+ (mapcar (lambda (arg)
+ (cons (car arg)
+ (propertize (cadr arg) 'face (car (cddr arg)))))
+ '((add "Added" stgit-modified-file-face)
+ (copy "Copied" stgit-modified-file-face)
+ (delete "Deleted" stgit-modified-file-face)
+ (modify "Modified" stgit-modified-file-face)
+ (rename "Renamed" stgit-modified-file-face)
+ (mode-change "Mode change" stgit-modified-file-face)
+ (unmerged "Unmerged" stgit-unmerged-file-face)
+ (unknown "Unknown" stgit-unknown-file-face)))
+ "Alist of code symbols to description strings")
+
+(defun stgit-file-status-code-as-string (code)
+ "Return stgit status code as string"
+ (let ((str (assq (if (consp code) (car code) code)
+ stgit-file-status-code-strings)))
+ (when str
+ (format "%-11s "
+ (if (and str (consp code) (/= (cdr code) 100))
+ (format "%s %s" (cdr str)
+ (propertize (format "%d%%" (cdr code))
+ 'face 'stgit-description-face))
+ (cdr str))))))
+
+(defun stgit-file-status-code (str &optional score)
+ "Return stgit status code from git status string"
+ (let ((code (assoc str '(("A" . add)
+ ("C" . copy)
+ ("D" . delete)
+ ("M" . modify)
+ ("R" . rename)
+ ("T" . mode-change)
+ ("U" . unmerged)
+ ("X" . unknown)))))
+ (setq code (if code (cdr code) 'unknown))
+ (when (stringp score)
+ (if (> (length score) 0)
+ (setq score (string-to-number score))
+ (setq score nil)))
+ (if score (cons code score) code)))
+
+(defconst stgit-file-type-strings
+ '((#o100 . "file")
+ (#o120 . "symlink")
+ (#o160 . "subproject"))
+ "Alist of names of file types")
+
+(defun stgit-file-type-string (type)
+ "Return string describing file type TYPE (the high bits of file permission).
+Cf. `stgit-file-type-strings' and `stgit-file-type-change-string'."
+ (let ((type-str (assoc type stgit-file-type-strings)))
+ (or (and type-str (cdr type-str))
+ (format "unknown type %o" type))))
+
+(defun stgit-file-type-change-string (old-perm new-perm)
+ "Return string describing file type change from OLD-PERM to NEW-PERM.
+Cf. `stgit-file-type-string'."
+ (let ((old-type (lsh old-perm -9))
+ (new-type (lsh new-perm -9)))
+ (cond ((= old-type new-type) "")
+ ((zerop new-type) "")
+ ((zerop old-type)
+ (if (= new-type #o100)
+ ""
+ (format " (%s)" (stgit-file-type-string new-type))))
+ (t (format " (%s -> %s)"
+ (stgit-file-type-string old-type)
+ (stgit-file-type-string new-type))))))
+
+(defun stgit-file-mode-change-string (old-perm new-perm)
+ "Return string describing file mode change from OLD-PERM to NEW-PERM.
+Cf. `stgit-file-type-change-string'."
+ (setq old-perm (logand old-perm #o777)
+ new-perm (logand new-perm #o777))
+ (if (or (= old-perm new-perm)
+ (zerop old-perm)
+ (zerop new-perm))
+ ""
+ (let* ((modified (logxor old-perm new-perm))
+ (not-x-modified (logand (logxor old-perm new-perm) #o666)))
+ (cond ((zerop modified) "")
+ ((and (zerop not-x-modified)
+ (or (and (eq #o111 (logand old-perm #o111))
+ (propertize "-x" 'face 'stgit-file-permission-face))
+ (and (eq #o111 (logand new-perm #o111))
+ (propertize "+x" 'face
+ 'stgit-file-permission-face)))))
+ (t (concat (propertize (format "%o" old-perm)
+ 'face 'stgit-file-permission-face)
+ (propertize " -> "
+ 'face 'stgit-description-face)
+ (propertize (format "%o" new-perm)
+ 'face 'stgit-file-permission-face)))))))
+
(defun stgit-expand-patch (patchsym)
+ "Expand (show modification of) the patch with name PATCHSYM (a
+symbol) at point.
+`stgit-expand-find-copies-harder' controls how hard to try to
+find copied files."
(save-excursion
(forward-line)
- (let ((start (point)))
- (stgit-run "files" (symbol-name patchsym))
-
- ;; 'stg files' outputs a single newline for empty patches; it
- ;; must be destroyed!
- (when (and (= (1+ start) (point))
- (= (char-before) ?\n))
- (delete-backward-char 1))
-
- (let ((end-marker (point-marker)))
- (if (= start (point))
- (insert-string " <no files>\n")
- (unless (looking-at "^")
- (insert ?\n))
- (while (and (zerop (forward-line -1))
- (>= (point) start))
- (insert " ")))
- (put-text-property start end-marker 'stgit-patchsym patchsym)))))
+ (let* ((start (point))
+ (result (with-output-to-string
+ (stgit-run-git "diff-tree" "-r" "-z"
+ (if stgit-expand-find-copies-harder
+ "--find-copies-harder"
+ "-C")
+ (stgit-id (symbol-name patchsym))))))
+ (let (mstart)
+ (while (string-match "\0:\\([0-7]+\\) \\([0-7]+\\) [0-9A-Fa-f]\\{40\\} [0-9A-Fa-f]\\{40\\} \\(\\([CR]\\)\\([0-9]*\\)\0\\([^\0]*\\)\0\\([^\0]*\\)\\|\\([ABD-QS-Z]\\)\0\\([^\0]*\\)\\)"
+ result mstart)
+ (let ((copy-or-rename (match-string 4 result))
+ (old-perm (read (format "#o%s" (match-string 1 result))))
+ (new-perm (read (format "#o%s" (match-string 2 result))))
+ (line-start (point))
+ status
+ change
+ properties)
+ (insert " ")
+ (if copy-or-rename
+ (let ((cr-score (match-string 5 result))
+ (cr-from-file (match-string 6 result))
+ (cr-to-file (match-string 7 result)))
+ (setq status (stgit-file-status-code copy-or-rename
+ cr-score)
+ properties (list 'stgit-old-file cr-from-file
+ 'stgit-new-file cr-to-file)
+ change (concat
+ cr-from-file
+ (propertize " -> "
+ 'face 'stgit-description-face)
+ cr-to-file)))
+ (setq status (stgit-file-status-code (match-string 8 result))
+ properties (list 'stgit-file (match-string 9 result))
+ change (match-string 9 result)))
+
+ (let ((mode-change (stgit-file-mode-change-string old-perm
+ new-perm)))
+ (insert (format "%-12s" (stgit-file-status-code-as-string
+ status))
+ mode-change
+ (if (> (length mode-change) 0) " " "")
+ change
+ (propertize (stgit-file-type-change-string old-perm
+ new-perm)
+ 'face 'stgit-description-face)
+ ?\n))
+ (add-text-properties line-start (point) properties))
+ (setq mstart (match-end 0))))
+ (when (= start (point))
+ (insert " <no files>\n"))
+ (put-text-property start (point) 'stgit-patchsym patchsym))))
(defun stgit-rescan ()
"Rescan the status buffer."
"Show status using `git-status'."
(interactive)
(unless (fboundp 'git-status)
- (error "stgit-git-status requires git-status"))
+ (error "The stgit-git-status command requires git-status"))
(let ((dir default-directory))
(save-selected-window
(pop-to-buffer nil)
(run-hooks 'stgit-mode-hook))
(defun stgit-add-mark (patch)
+ "Mark the patch named PATCH."
(let ((patchsym (intern patch)))
(setq stgit-marked-patches (cons patchsym stgit-marked-patches))))
(defun stgit-remove-mark (patch)
+ "Unmark the patch named PATCH."
(let ((patchsym (intern patch)))
(setq stgit-marked-patches (delq patchsym stgit-marked-patches))))
(defun stgit-clear-marks ()
+ "Unmark all patches."
(setq stgit-marked-patches '()))
(defun stgit-marked-patches ()
(and cause-error
(error "No patch on this line"))))
-(defun stgit-patched-file-at-point ()
- "Returns a cons of the patchsym and file name at point"
- (let ((patchsym (get-text-property (point) 'stgit-patchsym)))
- (when patchsym
- (save-excursion
- (beginning-of-line)
- (when (looking-at " [A-Z] \\(.*\\)")
- (cons patchsym (match-string-no-properties 1)))))))
+(defun stgit-patched-file-at-point (&optional both-files)
+ "Returns a cons of the patchsym and file name at point. For
+copies and renames, return the new file if the patch is either
+applied. If BOTH-FILES is non-nil, return a cons of the old and
+the new file names instead of just one name."
+ (let ((patchsym (get-text-property (point) 'stgit-patchsym))
+ (file (get-text-property (point) 'stgit-file)))
+ (cond ((not patchsym) nil)
+ (file (cons patchsym file))
+ (both-files
+ (cons patchsym (cons (get-text-property (point) 'stgit-old-file)
+ (get-text-property (point) 'stgit-new-file))))
+ (t
+ (let ((file-sym (save-excursion
+ (stgit-previous-patch)
+ (unless (equal (stgit-patch-at-point)
+ (symbol-name patchsym))
+ (error "Cannot find the %s patch" patchsym))
+ (beginning-of-line)
+ (if (= (char-after) ?-)
+ 'stgit-old-file
+ 'stgit-new-file))))
+ (cons patchsym (get-text-property (point) file-sym)))))))
(defun stgit-patches-marked-or-at-point ()
"Return the names of the marked patches, or the patch on the current line."
"Move point to the line containing PATCH."
(let ((p (point)))
(goto-char (point-min))
- (if (re-search-forward (concat "^[>+-][ *]" (regexp-quote patch) " ") nil t)
+ (if (re-search-forward (concat "^[>+-][ *]" (regexp-quote patch) " ")
+ nil t)
(progn (move-to-column goal-column)
t)
(goto-char p)
"Remove mark from the patch on the current line."
(interactive)
(stgit-remove-mark (stgit-patch-at-point t))
- (stgit-next-patch)
- (stgit-reload))
+ (stgit-reload)
+ (stgit-next-patch))
(defun stgit-rename (name)
"Rename the patch under point to NAME."
(stgit-capture-output "*StGit patch*"
(let ((patch (stgit-patch-at-point)))
(if (not patch)
- (let ((patched-file (stgit-patched-file-at-point)))
+ (let ((patched-file (stgit-patched-file-at-point t)))
(unless patched-file
(error "No patch or file at point"))
(let ((id (stgit-id (symbol-name (car patched-file)))))
(with-output-to-temp-buffer "*StGit diff*"
- (stgit-run-git "diff" (concat id "^") id (cdr patched-file))
+ (if (consp (cdr patched-file))
+ ;; two files (copy or rename)
+ (stgit-run-git "diff" "-C" "-C" (concat id "^") id "--"
+ (cadr patched-file) (cddr patched-file))
+ ;; just one file
+ (stgit-run-git "diff" (concat id "^") id "--"
+ (cdr patched-file)))
(with-current-buffer standard-output
(diff-mode)))))
(stgit-run "show" (stgit-patch-at-point))
(with-current-buffer log-edit-parent-buffer
(stgit-reload))))
-(defun stgit-new ()
- "Create a new patch."
- (interactive)
+(defun stgit-new (add-sign)
+ "Create a new patch.
+With a prefix argument, include a \"Signed-off-by:\" line at the
+end of the patch."
+ (interactive "P")
(let ((edit-buf (get-buffer-create "*StGit edit*"))
(dir default-directory))
(log-edit 'stgit-confirm-new t nil edit-buf)
- (setq default-directory dir)))
+ (setq default-directory dir)
+ (when add-sign
+ (save-excursion
+ (let ((standard-output (current-buffer)))
+ (stgit-run-silent "new" "--sign" "--save-template=-"))))))
(defun stgit-confirm-new ()
(interactive)
(let ((patch ""))
(while (> (length description) 0)
(cond ((string-match "\\`[a-zA-Z_-]+" description)
- (setq patch (downcase (concat patch (match-string 0 description))))
+ (setq patch (downcase (concat patch
+ (match-string 0 description))))
(setq description (substring description (match-end 0))))
((string-match "\\` +" description)
(setq patch (concat patch "-"))
(let ((patchargs (if arg
(let ((patches (stgit-patches-marked-or-at-point)))
(cond ((null patches)
- (error "no patch to update"))
+ (error "No patch to update"))
((> (length patches) 1)
- (error "too many patches selected"))
+ (error "Too many patches selected"))
(t
(cons "-p" patches))))
nil)))
~mdw / stgit / blobdiff