-(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 ())
- found-any)
- (goto-char (point-min))
- (while (not (eobp))
- (cond ((looking-at "Branch: \\(.*\\)")
- (put-text-property (match-beginning 1) (match-end 1)
- 'face 'bold))
- ((looking-at "\\([0 ]\\)\\([>+-]\\)\\( \\)\\([^ ]+\\) *[|#] \\(.*\\)")
- (setq found-any t)
- (let ((empty (match-string 1))
- (state (match-string 2))
- (patchsym (intern (match-string 4))))
- (put-text-property
- (match-beginning 4) (match-end 4) '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 5) (match-end 5)
- 'face 'stgit-description-face)
- (when (memq patchsym stgit-marked-patches)
- (save-excursion
- (replace-match "*" nil nil nil 3))
- (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))
- (when (equal "0" empty)
- (save-excursion
- (goto-char (match-beginning 5))
- (insert "(empty) ")))
- (delete-char 1)
- ))
- ((or (looking-at "stg series: Branch \".*\" not initialised")
- (looking-at "stg series: .*: branch not initialized"))
- (setq found-any t)
- (forward-line 1)
- (insert "Run M-x stgit-init to initialise")))
- (forward-line 1))
- (setq stgit-marked-patches (nreverse marked))
- (unless found-any
- (insert "\n "
- (propertize "no patches in series"
- 'face 'stgit-description-face))))))
+(defstruct (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 (from to common-head common-tail
+ (arrow (concat " "
+ (propertize "->" 'face 'stgit-description-face)
+ " ")))
+
+ (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 ((status (stgit-file-status file))
+ (name (if (stgit-file-copy-or-rename file)
+ (stgit-describe-copy-or-rename file)
+ (stgit-file-file file)))
+ (mode-change (stgit-file-mode-change-string
+ (stgit-file-old-perm file)
+ (stgit-file-new-perm file)))
+ (start (point)))
+ (insert (format " %-12s%s%s%s%s\n"
+ (stgit-file-status-code-as-string file)
+ mode-change
+ (if (zerop (length mode-change)) "" " ")
+ name
+ (propertize (stgit-file-type-change-string
+ (stgit-file-old-perm file)
+ (stgit-file-new-perm file))
+ 'face 'stgit-description-face)))
+ (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-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)))
+ (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)
+ `("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 stgit-show-ignored
+ (stgit-insert-ls-files '("--ignored" "--others") "I"))
+ (when stgit-show-unknown
+ (stgit-insert-ls-files '("--others") "X"))
+ (sort-regexp-fields nil ":[^\0]*\0\\([^\0]*\\)\0" "\\1"
+ (point-min) (point-max)))
+
+ (goto-char (point-min))
+ (unless (or (eobp) (memq patchsym '(:work :index)))
+ (forward-char 41))
+ (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))
+ (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-select-patch ()
+ (let ((patchname (stgit-patch-name-at-point)))
+ (if (memq patchname stgit-expanded-patches)
+ (setq stgit-expanded-patches (delq patchname stgit-expanded-patches))
+ (setq stgit-expanded-patches (cons patchname stgit-expanded-patches)))
+ (ewoc-invalidate stgit-ewoc (ewoc-locate stgit-ewoc)))
+ (move-to-column (stgit-goal-column)))
~mdw / stgit / blobdiff