-(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))
- (result (with-output-to-string
- (stgit-run-git "diff-tree" "-r" "-z"
- (if stgit-expand-find-copies-harder
- "--find-copies-harder"
- "-C")
- (stgit-id 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-file-patchsym patchsym))))
-
-(defun stgit-rescan ()
- "Rescan the status buffer."
- (save-excursion
- (let ((marked ()))
- (goto-char (point-min))
- (while (not (eobp))
- (cond ((looking-at "Branch: \\(.*\\)")
- (put-text-property (match-beginning 1) (match-end 1)
- 'face 'bold))
- ((looking-at "\\([>+-]\\)\\( \\)\\([^ ]+\\) *[|#] \\(.*\\)")
- (let ((state (match-string 1))
- (patchsym (intern (match-string 3))))
- (put-text-property
- (match-beginning 3) (match-end 3) 'face
- (cond ((string= state ">") 'stgit-top-patch-face)
- ((string= state "+") 'stgit-applied-patch-face)
- ((string= state "-") 'stgit-unapplied-patch-face)))
- (put-text-property (match-beginning 4) (match-end 4)
- 'face 'stgit-description-face)
- (when (memq patchsym stgit-marked-patches)
- (replace-match "*" nil nil nil 2)
- (setq marked (cons patchsym marked)))
- (put-text-property (match-beginning 0) (match-end 0)
- 'stgit-patchsym patchsym)
- (when (memq patchsym stgit-expanded-patches)
- (stgit-expand-patch patchsym))
- ))
- ((or (looking-at "stg series: Branch \".*\" not initialised")
- (looking-at "stg series: .*: branch not initialized"))
- (forward-line 1)
- (insert "Run M-x stgit-init to initialise")))
- (forward-line 1))
- (setq stgit-marked-patches (nreverse marked)))))
+(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))))