+(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)))))))
+
+(defstruct (stgit-file
+ (:conc-name stgit-file->))
+ old-perm new-perm copy-or-rename cr-score cr-from cr-to status file)
+
+(defun stgit-describe-copy-or-rename (file)
+ (let ((arrow (concat " " (propertize "->" 'face 'stgit-description-face) " "))
+ from to common-head common-tail)
+
+ (when stgit-abbreviate-copies-and-renames
+ (setq from (split-string (stgit-file->cr-from file) "/")
+ to (split-string (stgit-file->cr-to file) "/"))
+
+ (while (and from to (cdr from) (cdr to)
+ (string-equal (car from) (car to)))
+ (setq common-head (cons (car from) common-head)
+ from (cdr from)
+ to (cdr to)))
+ (setq common-head (nreverse common-head)
+ from (nreverse from)
+ to (nreverse to))
+ (while (and from to (cdr from) (cdr to)
+ (string-equal (car from) (car to)))
+ (setq common-tail (cons (car from) common-tail)
+ from (cdr from)
+ to (cdr to)))
+ (setq from (nreverse from)
+ to (nreverse to)))
+
+ (if (or common-head common-tail)
+ (concat (if common-head
+ (mapconcat #'identity common-head "/")
+ "")
+ (if common-head "/" "")
+ (propertize "{" 'face 'stgit-description-face)
+ (mapconcat #'identity from "/")
+ arrow
+ (mapconcat #'identity to "/")
+ (propertize "}" 'face 'stgit-description-face)
+ (if common-tail "/" "")
+ (if common-tail
+ (mapconcat #'identity common-tail "/")
+ ""))
+ (concat (stgit-file->cr-from file) arrow (stgit-file->cr-to file)))))
+
+(defun stgit-file-pp (file)
+ (let ((start (point))
+ (spec (format-spec-make
+ ?s (stgit-file-status-code-as-string file)
+ ?m (stgit-file-mode-change-string
+ (stgit-file->old-perm file)
+ (stgit-file->new-perm file))
+ ?n (if (stgit-file->copy-or-rename file)
+ (stgit-describe-copy-or-rename file)
+ (stgit-file->file file))
+ ?c (propertize (stgit-file-type-change-string
+ (stgit-file->old-perm file)
+ (stgit-file->new-perm file))
+ 'face 'stgit-description-face))))
+ (stgit-insert-without-trailing-whitespace
+ (format-spec stgit-file-line-format spec))
+ (add-text-properties start (point)
+ (list 'entry-type 'file
+ 'file-data file))))
+
+(defun stgit-find-copies-harder-diff-arg ()
+ "Return the flag to use with `git-diff' depending on the
+`stgit-find-copies-harder' flag."
+ (if stgit-find-copies-harder "--find-copies-harder" "-C"))
+
+(defun stgit-insert-ls-files (args file-flag)
+ (let ((start (point)))
+ (apply 'stgit-run-git
+ (append '("ls-files" "--exclude-standard" "-z") args))
+ (goto-char start)
+ (while (looking-at "\\([^\0]*\\)\0")
+ (let ((name-len (- (match-end 0) (match-beginning 0))))
+ (insert ":0 0 0000000000000000000000000000000000000000 0000000000000000000000000000000000000000 " file-flag "\0")
+ (forward-char name-len)))))
+
+(defun stgit-process-files (callback)
+ (goto-char (point-min))
+ (when (looking-at "[0-9A-Fa-f]\\{40\\}\0")
+ (goto-char (match-end 0)))
+ (while (looking-at ":\\([0-7]+\\) \\([0-7]+\\) [0-9A-Fa-f]\\{40\\} [0-9A-Fa-f]\\{40\\} ")
+ (let ((old-perm (string-to-number (match-string 1) 8))
+ (new-perm (string-to-number (match-string 2) 8)))
+ (goto-char (match-end 0))
+ (let ((file
+ (cond ((looking-at
+ "\\([CR]\\)\\([0-9]*\\)\0\\([^\0]*\\)\0\\([^\0]*\\)\0")
+ (let* ((patch-status (stgit-patch->status patch))
+ (file-subexp (if (eq patch-status 'unapplied)
+ 3
+ 4))
+ (file (match-string file-subexp)))
+ (make-stgit-file
+ :old-perm old-perm
+ :new-perm new-perm
+ :copy-or-rename t
+ :cr-score (string-to-number (match-string 2))
+ :cr-from (match-string 3)
+ :cr-to (match-string 4)
+ :status (stgit-file-status-code
+ (match-string 1))
+ :file file)))
+ ((looking-at "\\([ABD-QS-Z]\\)\0\\([^\0]*\\)\0")
+ (make-stgit-file
+ :old-perm old-perm
+ :new-perm new-perm
+ :copy-or-rename nil
+ :cr-score nil
+ :cr-from nil
+ :cr-to nil
+ :status (stgit-file-status-code
+ (match-string 1))
+ :file (match-string 2))))))
+ (goto-char (match-end 0))
+ (funcall callback file)))))
+
+
+(defun stgit-insert-patch-files (patch)
+ "Expand (show modification of) the patch PATCH after the line
+at point."
+ (let* ((patchsym (stgit-patch->name patch))
+ (end (point-marker))
+ (args (list "-z" (stgit-find-copies-harder-diff-arg)))
+ (ewoc (ewoc-create #'stgit-file-pp nil nil t))
+ (show-ignored stgit-show-ignored)
+ (show-unknown stgit-show-unknown))
+ (set-marker-insertion-type end t)
+ (setf (stgit-patch->files-ewoc patch) ewoc)
+ (with-temp-buffer
+ (let ((standard-output (current-buffer)))
+ (apply 'stgit-run-git
+ (cond ((eq patchsym :work)
+ (let (standard-output)
+ (stgit-run-git "update-index" "--refresh"))
+ `("diff-files" "-0" ,@args))
+ ((eq patchsym :index)
+ `("diff-index" ,@args "--cached" "HEAD"))
+ (t
+ `("diff-tree" ,@args "-r" ,(stgit-id patchsym)))))
+
+ (when (and (eq patchsym :work))
+ (when show-ignored
+ (stgit-insert-ls-files '("--ignored" "--others") "I"))
+ (when show-unknown
+ (stgit-insert-ls-files '("--directory" "--no-empty-directory"
+ "--others")
+ "X"))
+ (sort-regexp-fields nil ":[^\0]*\0\\([^\0]*\\)\0" "\\1"
+ (point-min) (point-max)))
+
+ (stgit-process-files (lambda (file) (ewoc-enter-last ewoc file)))
+
+ (unless (ewoc-nth ewoc 0)
+ (ewoc-set-hf ewoc ""
+ (concat " "
+ (propertize "<no files>"
+ 'face 'stgit-description-face)
+ "\n")))))
+ (goto-char end)))
+
+(defun stgit-find-file (&optional other-window)
+ (let* ((file (or (stgit-patched-file-at-point)
+ (error "No file at point")))
+ (filename (expand-file-name (stgit-file->file file))))
+ (unless (file-exists-p filename)
+ (error "File does not exist"))
+ (funcall (if other-window 'find-file-other-window 'find-file)
+ filename)
+ (when (eq (stgit-file->status file) 'unmerged)
+ (smerge-mode 1))))
+
+(defun stgit-expand (&optional patches collapse)
+ "Show the contents of marked patches, or the patch at point.
+
+See also `stgit-collapse'.
+
+Non-interactively, operate on PATCHES, and collapse instead of
+expand if COLLAPSE is not nil."
+ (interactive (list (stgit-patches-marked-or-at-point t)))
+ (stgit-assert-mode)
+ (let ((patches-diff (funcall (if collapse #'intersection #'set-difference)
+ patches stgit-expanded-patches)))
+ (setq stgit-expanded-patches
+ (if collapse
+ (set-difference stgit-expanded-patches patches-diff)
+ (append stgit-expanded-patches patches-diff)))
+ (ewoc-map #'(lambda (patch)
+ (memq (stgit-patch->name patch) patches-diff))
+ stgit-ewoc))
+ (move-to-column (stgit-goal-column)))
+
+(defun stgit-collapse (&optional patches)
+ "Hide the contents of marked patches, or the patch at point.
+
+See also `stgit-expand'."
+ (interactive (list (stgit-patches-marked-or-at-point t)))
+ (stgit-assert-mode)
+ (stgit-expand patches t))
+
+(defun stgit-select-patch ()
+ (let ((patchname (stgit-patch-name-at-point)))
+ (stgit-expand (list patchname)
+ (memq patchname stgit-expanded-patches))))
+
+(defun stgit-expand-directory (file)
+ (let* ((patch (stgit-patch-at-point))
+ (ewoc (stgit-patch->files-ewoc patch))
+ (node (ewoc-locate ewoc))
+ (filename (stgit-file->file file))
+ (start (make-marker))
+ (end (make-marker)))
+
+ (save-excursion
+ (forward-line 1)
+ (set-marker start (point))
+ (set-marker end (point))
+ (set-marker-insertion-type end t))
+
+ (assert (string-match "/$" filename))
+ ;; remove trailing "/"
+ (setf (stgit-file->file file) (substring filename 0 -1))
+ (ewoc-invalidate ewoc node)
+
+ (with-temp-buffer
+ (let ((standard-output (current-buffer)))
+ (stgit-insert-ls-files (list "--directory" "--others"
+ "--no-empty-directory" "--"
+ filename)
+ "X")
+ (stgit-process-files (lambda (f)
+ (setq node (ewoc-enter-after ewoc node f))))))
+
+ (move-to-column (stgit-goal-column))
+
+ (let ((inhibit-read-only t))
+ (put-text-property start end 'patch-data patch))))
+
+(defun stgit-select-file ()
+ (let* ((file (or (stgit-patched-file-at-point)
+ (error "No file at point")))
+ (filename (stgit-file->file file)))
+ (if (string-match "/$" filename)
+ (stgit-expand-directory file)
+ (stgit-find-file))))
+
+(defun stgit-select ()
+ "With point on a patch, toggle showing files in the patch.
+
+With point on a file, open the associated file. Opens the target
+file for (applied) copies and renames."
+ (interactive)
+ (stgit-assert-mode)
+ (case (get-text-property (point) 'entry-type)
+ ('patch
+ (stgit-select-patch))
+ ('file
+ (stgit-select-file))
+ (t
+ (error "No patch or file on line"))))
+
+(defun stgit-find-file-other-window ()
+ "Open file at point in other window"
+ (interactive)
+ (stgit-assert-mode)
+ (stgit-find-file t))
+
+(defun stgit-find-file-merge ()
+ "Open file at point and merge it using `smerge-ediff'."
+ (interactive)
+ (stgit-assert-mode)
+ (stgit-find-file t)
+ (smerge-ediff))