comparison lisp/vc.el @ 93425:8459d55c7312

Allow backends to display backend specific information in the vc-status listing. (vc-status-fileinfo): Add a field for backend specific information. (vc-status-printer): Rename to ... (vc-default-status-printer): ... this. (vc-status-printer): New function. (vc-update-vc-status-buffer): Set the backend specific file info if provided.

93424:bc6b2ba17b08

;;   change.  This is a replacement for `dir-state'.
;;
;; - status-extra-headers (dir)
;;
;;   Return a string that will be added to the *vc-status* buffer header.
;;
;; * working-revision (file)
;;
;;   Return the working revision of FILE.  This is the revision fetched
;;   by the last checkout or upate, not necessarily the same thing as the

;;; Experimental code for the vc-dired replacement
(require 'ewoc)

(defstruct (vc-status-fileinfo
            (:copier nil)
            (:constructor vc-status-create-fileinfo (state name &optional marked))
            (:conc-name vc-status-fileinfo->))
  marked
  state
  name)

(defvar vc-status nil)

(defun vc-default-status-extra-headers (backend dir)
  "Extra      : Add backend specific headers here")

   (propertize "Working dir: " 'face 'font-lock-type-face)
   (propertize (format "%s\n" dir) 'face 'font-lock-variable-name-face)
   (vc-call-backend backend 'status-extra-headers dir)
   "\n"))

(defun vc-status-printer (fileentry)
  "Pretty print FILEENTRY."
  ;; If you change the layout here, change vc-status-move-to-goal-column.
  (let ((state (vc-status-fileinfo->state fileentry)))
    (insert
     (propertize

     (propertize
      (format "%s" (vc-status-fileinfo->name fileentry))
      'face 'font-lock-function-name-face
      'mouse-face 'highlight))))

(defun vc-status-move-to-goal-column ()
  (beginning-of-line)
  ;; Must be in sync with vc-status-printer.
  (forward-char 25))

(defun vc-status-prepare-status-buffer (dir &optional create-new)
  "Find a *vc-status* buffer showing DIR, or create a new one."
  (setq dir (expand-file-name dir))

(defun vc-update-vc-status-buffer (entries buffer)
  (with-current-buffer buffer
    (when entries
      ;; Insert the entries we got into the ewoc.
      (dolist (entry entries)
	(ewoc-enter-last vc-status
			 (vc-status-create-fileinfo (cdr entry) (car entry))))
      ;; If we had marked items before the refresh, try mark them here.
      ;; XXX: there should be a better way to do this...
      (when vc-status-crt-marked
	(ewoc-map
	 (lambda (arg)

	    ;; Found the file, just update the status.
	    (setf (vc-status-fileinfo->state (ewoc-data crt)) (cdr entry))
	    (ewoc-invalidate vc-status crt))
	;; Could not find the file, insert a new entry.
	(ewoc-enter-last
	 vc-status (vc-status-create-fileinfo (cdr entry) (car entry)))))))

(defun vc-status-refresh ()
  "Refresh the contents of the VC status buffer.
Throw an error if another update process is in progress."
  (interactive)

93425:8459d55c7312

;;   change.  This is a replacement for `dir-state'.
;;
;; - status-extra-headers (dir)
;;
;;   Return a string that will be added to the *vc-status* buffer header.
;;
;; - status-printer (fileinfo)
;;
;;   Pretty print the `vc-status-fileinfo' FILEINFO.
;;   If a backend needs to show more information than the default FILE
;;   and STATE in the vc-status listing, it can store that extra
;;   information in `vc-status-fileinfo->extra'.  This function can be
;;   used to display that extra information in the vc-status buffer.
;;
;; * working-revision (file)
;;
;;   Return the working revision of FILE.  This is the revision fetched
;;   by the last checkout or upate, not necessarily the same thing as the

;;; Experimental code for the vc-dired replacement
(require 'ewoc)

(defstruct (vc-status-fileinfo
            (:copier nil)
            (:constructor
	     vc-status-create-fileinfo (name state extra &optional marked))
            (:conc-name vc-status-fileinfo->))
  marked
  state
  name
  ;; For storing backend specific information.
  extra)

(defvar vc-status nil)

(defun vc-default-status-extra-headers (backend dir)
  "Extra      : Add backend specific headers here")

   (propertize "Working dir: " 'face 'font-lock-type-face)
   (propertize (format "%s\n" dir) 'face 'font-lock-variable-name-face)
   (vc-call-backend backend 'status-extra-headers dir)
   "\n"))

(defun vc-default-status-printer (backend fileentry)
  "Pretty print FILEENTRY."
  ;; If you change the layout here, change vc-status-move-to-goal-column.
  (let ((state (vc-status-fileinfo->state fileentry)))
    (insert
     (propertize

     (propertize
      (format "%s" (vc-status-fileinfo->name fileentry))
      'face 'font-lock-function-name-face
      'mouse-face 'highlight))))

(defun vc-status-printer (fileentry)
  (let ((backend (vc-responsible-backend default-directory)))
    (vc-call-backend backend 'status-printer fileentry)))

(defun vc-status-move-to-goal-column ()
  (beginning-of-line)
  ;; Must be in sync with vc-default-status-printer.
  (forward-char 25))

(defun vc-status-prepare-status-buffer (dir &optional create-new)
  "Find a *vc-status* buffer showing DIR, or create a new one."
  (setq dir (expand-file-name dir))

(defun vc-update-vc-status-buffer (entries buffer)
  (with-current-buffer buffer
    (when entries
      ;; Insert the entries we got into the ewoc.
      (dolist (entry entries)
	(let* ((file (car entry))
	       (entrycdr (cdr entry))
	       (state (if (listp entrycdr) (nth 1 entry)))
	       (extra (if (listp entrycdr) (nth 2 entry))))
	(ewoc-enter-last vc-status
			 (vc-status-create-fileinfo file state extra))))
      ;; If we had marked items before the refresh, try mark them here.
      ;; XXX: there should be a better way to do this...
      (when vc-status-crt-marked
	(ewoc-map
	 (lambda (arg)

	    ;; Found the file, just update the status.
	    (setf (vc-status-fileinfo->state (ewoc-data crt)) (cdr entry))
	    (ewoc-invalidate vc-status crt))
	;; Could not find the file, insert a new entry.
	(ewoc-enter-last
	 ;; XXX: `vc-status-fileinfo->extra' is not set here.
	 ;; It might need to be.
	 vc-status 
	 (vc-status-create-fileinfo (car entry) (cdr entry) nil))))))

(defun vc-status-refresh ()
  "Refresh the contents of the VC status buffer.
Throw an error if another update process is in progress."
  (interactive)