Mercurial > emacs

changeset 93426:912e50ecb992

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
* vc-git.el: Make vc-status display information about copies, renames and permission changes. (vc-git-extra-fileinfo): New defstruct. (vc-git-escape-file-name, vc-git-file-type-as-string) (vc-git-rename-as-string, vc-git-permissions-as-string) (vc-git-status-printer): New functions. (vc-git-after-dir-status-stage2): Also return vc-git-extra-fileinfo. (vc-git-after-dir-status-stage1): Look for copies, renames and permission changes. (vc-git-after-dir-status-stage1-empty-db): Set permissions. (vc-git-dir-status): Ask for staged files and renames.
author Dan Nicolaescu <dann@ics.uci.edu>
date Sun, 30 Mar 2008 15:44:34 +0000
parents 8459d55c7312
children 753ad51473c7
files lisp/ChangeLog lisp/vc-git.el
diffstat 2 files changed, 135 insertions(+), 9 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sun Mar 30 15:29:35 2008 +0000
+++ b/lisp/ChangeLog	Sun Mar 30 15:44:34 2008 +0000
@@ -1,3 +1,17 @@
+2008-03-30  Alexandre Julliard  <julliard@winehq.org>
+
+	* vc-git.el: Make vc-status display information about copies,
+	renames and permission changes.
+	(vc-git-extra-fileinfo): New defstruct.
+	(vc-git-escape-file-name, vc-git-file-type-as-string)
+	(vc-git-rename-as-string, vc-git-permissions-as-string)
+	(vc-git-status-printer): New functions.
+	(vc-git-after-dir-status-stage2): Also return vc-git-extra-fileinfo.
+	(vc-git-after-dir-status-stage1): Look for copies, renames and
+	permission changes.
+	(vc-git-after-dir-status-stage1-empty-db): Set permissions.
+	(vc-git-dir-status): Ask for staged files and renames.
+
 2008-03-30  Dan Nicolaescu  <dann@ics.uci.edu>
 
 	* vc.el: Allow backends to display backend specific information in
--- a/lisp/vc-git.el	Sun Mar 30 15:29:35 2008 +0000
+++ b/lisp/vc-git.el	Sun Mar 30 15:44:34 2008 +0000
@@ -208,23 +208,133 @@
       (propertize def-ml
                   'help-echo (concat help-echo "\nCurrent branch: " branch)))))
 
+(defstruct (vc-git-extra-fileinfo
+            (:copier nil)
+            (:constructor vc-git-create-extra-fileinfo (old-perm new-perm &optional rename-state orig-name))
+            (:conc-name vc-git-extra-fileinfo->))
+  old-perm new-perm   ;; permission flags
+  rename-state        ;; rename or copy state
+  orig-name)          ;; original name for renames or copies
+
+(defun vc-git-escape-file-name (name)
+  "Escape a file name if necessary."
+  (if (string-match "[\n\t\"\\]" name)
+      (concat "\""
+              (mapconcat (lambda (c)
+                   (case c
+                     (?\n "\\n")
+                     (?\t "\\t")
+                     (?\\ "\\\\")
+                     (?\" "\\\"")
+                     (t (char-to-string c))))
+                 name "")
+              "\"")
+    name))
+
+(defun vc-git-file-type-as-string (old-perm new-perm)
+  "Return a string describing the file type based on its permissions."
+  (let* ((old-type (lsh (or old-perm 0) -9))
+	 (new-type (lsh (or new-perm 0) -9))
+	 (str (case new-type
+		(?\100  ;; file
+		 (case old-type
+		   (?\100 nil)
+		   (?\120 "   (type change symlink -> file)")
+		   (?\160 "   (type change subproject -> file)")))
+		 (?\120  ;; symlink
+		  (case old-type
+		    (?\100 "   (type change file -> symlink)")
+		    (?\160 "   (type change subproject -> symlink)")
+		    (t "   (symlink)")))
+		  (?\160  ;; subproject
+		   (case old-type
+		     (?\100 "   (type change file -> subproject)")
+		     (?\120 "   (type change symlink -> subproject)")
+		     (t "   (subproject)")))
+                  (?\110 nil)  ;; directory (internal, not a real git state)
+		  (?\000  ;; deleted or unknown
+		   (case old-type
+		     (?\120 "   (symlink)")
+		     (?\160 "   (subproject)")))
+		  (t (format "   (unknown type %o)" new-type)))))
+    (cond (str (propertize str 'face 'font-lock-comment-face))
+          ((eq new-type ?\110) "/")
+          (t ""))))
+
+(defun vc-git-rename-as-string (state extra)
+  "Return a string describing the copy or rename associated with INFO, or an empty string if none."
+  (let ((rename-state (when extra 
+			(vc-git-extra-fileinfo->rename-state extra))))
+    (if rename-state
+        (propertize
+         (concat "   ("
+                 (if (eq rename-state 'copy) "copied from "
+                   (if (eq state 'added) "renamed from "
+                     "renamed to "))
+                 (vc-git-escape-file-name (vc-git-extra-fileinfo->orig-name extra))
+                 ")") 'face 'font-lock-comment-face)
+      "")))
+
+(defun vc-git-permissions-as-string (old-perm new-perm)
+  "Format a permission change as string."
+  (propertize
+   (if (or (not old-perm)
+           (not new-perm)
+           (eq 0 (logand ?\111 (logxor old-perm new-perm))))
+       "  "
+     (if (eq 0 (logand ?\111 old-perm)) "+x" "-x"))
+  'face 'font-lock-type-face))
+
+(defun vc-git-status-printer (info)
+  "Pretty-printer for the vc-status-fileinfo structure."
+  (let* ((state (vc-status-fileinfo->state info))
+         (extra (vc-status-fileinfo->extra info))
+         (old-perm (when extra (vc-git-extra-fileinfo->old-perm extra)))
+         (new-perm (when extra (vc-git-extra-fileinfo->new-perm extra))))
+    (insert
+     "  "
+     (propertize (format "%c" (if (vc-status-fileinfo->marked info) ?* ? ))
+                 'face 'font-lock-type-face)
+     "  "
+     (propertize
+      (format "%-12s" state)
+      'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
+		  ((eq state 'missing) 'font-lock-warning-face)
+		  (t 'font-lock-variable-name-face))
+      'mouse-face 'highlight)
+     "  " (vc-git-permissions-as-string old-perm new-perm)
+     "     "
+     (propertize (vc-git-escape-file-name (vc-status-fileinfo->name info))
+                 'face 'font-lock-function-name-face
+                 'mouse-face 'highlight)
+     (vc-git-file-type-as-string old-perm new-perm)
+     (vc-git-rename-as-string state extra))))
+
 ;; Variable used to keep the intermediate results for vc-git-status.
 (defvar vc-git-status-result nil)
 
 (defun vc-git-after-dir-status-stage2 (update-function status-buffer)
   (goto-char (point-min))
   (while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
-    (push (cons (match-string 1) 'unregistered) vc-git-status-result))
+    (push (list (match-string 1) 'unregistered (vc-git-create-extra-fileinfo 0 0)) vc-git-status-result))
   (funcall update-function (nreverse vc-git-status-result) status-buffer))
 
 (defun vc-git-after-dir-status-stage1 (update-function status-buffer)
   (goto-char (point-min))
   (while (re-search-forward
-	  ":[0-7]\\{6\\} [0-7]\\{6\\} [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\([ADMUT]\\)\0\\([^\0]+\\)\0"
+          ":\\([0-7]\\{6\\}\\) \\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\(\\([ADMUT]\\)\0\\([^\0]+\\)\\|\\([CR]\\)[0-9]*\0\\([^\0]+\\)\0\\([^\0]+\\)\\)\0"
 	  nil t 1)
-    (let ((filename (match-string 2))
-	  (status (vc-git--state-code (match-string 1))))
-      (push (cons filename status) vc-git-status-result)))
+    (let ((old-perm (string-to-number (match-string 1) 8))
+          (new-perm (string-to-number (match-string 2) 8))
+          (state (or (match-string 4) (match-string 6)))
+          (name (or (match-string 5) (match-string 7)))
+          (new-name (match-string 8)))
+      (if new-name  ; copy or rename
+          (if (eq ?C (string-to-char state))
+              (push (list new-name 'added (vc-git-create-extra-fileinfo old-perm new-perm 'copy name)) vc-git-status-result)
+            (push (list name 'removed (vc-git-create-extra-fileinfo 0 0 'rename new-name)) vc-git-status-result)
+            (push (list new-name 'added (vc-git-create-extra-fileinfo old-perm new-perm 'rename name)) vc-git-status-result))
+        (push (list name (vc-git--state-code state) (vc-git-create-extra-fileinfo old-perm new-perm)) vc-git-status-result))))
   (erase-buffer)
   (vc-git-command (current-buffer) 'async nil "ls-files" "-z" "-o"
 		  "--directory" "--no-empty-directory" "--exclude-standard")
@@ -233,8 +343,10 @@
 
 (defun vc-git-after-dir-status-stage1-empty-db (update-function status-buffer)
   (goto-char (point-min))
-  (while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
-    (push (cons (match-string 1) 'added) vc-git-status-result))
+  (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
+    (let ((new-perm (string-to-number (match-string 1) 8))
+          (name (match-string 2)))
+      (push (list name 'added (vc-git-create-extra-fileinfo 0 new-perm)) vc-git-status-result)))
   (erase-buffer)
   (vc-git-command (current-buffer) 'async nil "ls-files" "-z" "-o"
 		  "--directory" "--no-empty-directory" "--exclude-standard")
@@ -249,11 +361,11 @@
   (set (make-local-variable 'vc-git-status-result) nil)
   (if (vc-git--empty-db-p)
       (progn
-	(vc-git-command (current-buffer) 'async nil "ls-files" "-z" "-c")
+	(vc-git-command (current-buffer) 'async nil "ls-files" "-z" "-c" "-s")
 	(vc-exec-after
 	 `(vc-git-after-dir-status-stage1-empty-db 
 	   (quote ,update-function) ,status-buffer)))
-    (vc-git-command (current-buffer) 'async nil "diff-index" "-z" "HEAD")
+    (vc-git-command (current-buffer) 'async nil "diff-index" "-z" "-M" "HEAD")
     (vc-exec-after
      `(vc-git-after-dir-status-stage1 (quote ,update-function) ,status-buffer))))