tfs.el

;;; tfs.el --- MS Team Foundation Server commands for Emacs.

;; Author     : Dino Chiesa <dpchiesa@hotmail.com>
;; Version    : 0.2.6
;; X-URL      : http://cheeso.members.winisp.net/srcview.aspx?dir=emacs&file=tfs.el
;; Last saved : <2011-May-03 10:49:03>
;;
;; Copyright 2009-2010 Dino Chiesa

;; Microsoft Public License (Ms-PL)
;;
;; This license governs use of the accompanying software, the tfs.el
;; library ("the software"). If you use the software, you accept this
;; license. If you do not accept the license, do not use the software.
;;
;; 1. Definitions
;;
;; The terms "reproduce," "reproduction," "derivative works," and
;; "distribution" have the same meaning here as under U.S. copyright
;; law.
;;
;; A "contribution" is the original software, or any additions or
;; changes to the software.
;;
;; A "contributor" is any person that distributes its contribution under
;; this license.
;;
;; "Licensed patents" are a contributor's patent claims that read
;; directly on its contribution.
;;
;; 2. Grant of Rights
;;
;; (A) Copyright Grant- Subject to the terms of this license, including
;; the license conditions and limitations in section 3, each contributor
;; grants you a non-exclusive, worldwide, royalty-free copyright license
;; to reproduce its contribution, prepare derivative works of its
;; contribution, and distribute its contribution or any derivative works
;; that you create.
;;
;; (B) Patent Grant- Subject to the terms of this license, including the
;; license conditions and limitations in section 3, each contributor
;; grants you a non-exclusive, worldwide, royalty-free license under its
;; licensed patents to make, have made, use, sell, offer for sale,
;; import, and/or otherwise dispose of its contribution in the software
;; or derivative works of the contribution in the software.
;;
;; 3. Conditions and Limitations
;;
;; (A) No Trademark License- This license does not grant you rights to
;; use any contributors' name, logo, or trademarks.
;;
;; (B) If you bring a patent claim against any contributor over patents
;; that you claim are infringed by the software, your patent license
;; from such contributor to the software ends automatically.
;;
;; (C) If you distribute any portion of the software, you must retain
;; all copyright, patent, trademark, and attribution notices that are
;; present in the software.
;;
;; (D) If you distribute any portion of the software in source code
;; form, you may do so only under this license by including a complete
;; copy of this license with your distribution. If you distribute any
;; portion of the software in compiled or object code form, you may only
;; do so under a license that complies with this license.
;;
;; (E) The software is licensed "as-is." You bear the risk of using
;; it. The contributors give no express warranties, guarantees or
;; conditions. You may have additional consumer rights under your local
;; laws which this license cannot change. To the extent permitted under
;; your local laws, the contributors exclude the implied warranties of
;; merchantability, fitness for a particular purpose and
;; non-infringement.

;;; Commentary:
;;
;; Basic steps to setup:
;;   1. Place `tfs.el' in your `load-path'.
;;   2. In your .emacs file:
;;        (require 'tfs)
;;        (setq tfs/tf-exe  "c:\\vs2008\\common7\\ide\\tf.exe")
;;        (setq tfs/login "/login:domain\\userid,password")
;;              -or-
;;        (setq tfs/login (getenv "TFSLOGIN"))
;;   3. also in your .emacs file:
;;        set local or global key bindings for tfs commands.  like so:
;;
;;        (global-set-key  "\C-xvo" 'tfs/checkout)
;;        (global-set-key  "\C-xvi" 'tfs/checkin)
;;        (global-set-key  "\C-xvp" 'tfs/properties)
;;        (global-set-key  "\C-xvr" 'tfs/rename)
;;        (global-set-key  "\C-xvg" 'tfs/get)
;;        (global-set-key  "\C-xvh" 'tfs/history)
;;        (global-set-key  "\C-xvu" 'tfs/undo)
;;        (global-set-key  "\C-xvd" 'tfs/diff)
;;        (global-set-key  "\C-xv-" 'tfs/delete)
;;        (global-set-key  "\C-xv+" 'tfs/add)
;;        (global-set-key  "\C-xvs" 'tfs/status)
;;        (global-set-key  "\C-xva" 'tfs/annotate)
;;        (global-set-key  "\C-xvw" 'tfs/workitem)
;;
;;


(defvar tfs/tf-exe  "c:\\Program Files\\Microsoft Visual Studio 9.0\\common7\\ide\\tf.exe"
  "location of the tf.exe command.  Defaults to \"c:\\Program Files\\Microsoft Visual Studio 9.0\\common7\\ide\\tf.exe\"")

(defvar tfs/tfpt-exe  "c:\\Program Files\\Microsoft Team Foundation Server 2008 Power Tools\\TFPT.exe"
  "location of the tfpt.exe command.  Defaults to \"c:\\Program Files\\Microsoft Team Foundation Server 2008 Power Tools\\TFPT.exe\"")

(defvar tfs/login "/login:domain\\user,password"
  "/login option for all TFS activity.")

(defvar tfs/buffer-name "*TFS Messages*"
  "name of buffer for TFS Messages")



;; -------------------------------------------------------
;; tfs/checkout
;; performs a TFS checkout on the file being visited by the current buffer.
(defun tfs/checkout ()
  "Performs a tf checkout (edit) on the file being visited by the current buffer.  Checkout happens only if the file is non-writable now. In other words checkout will fail if the local file is currently writable."
  (interactive)
  (if buffer-file-name
      (if (not (file-writable-p buffer-file-name))
          (let* ((exitcode nil)
                 (shortname (file-name-nondirectory buffer-file-name))
                 (command (list tfs/tf-exe "checkout" shortname)))
            (tfs/append-to-message-buffer (concat "checkout " shortname ": "
                                                  (prin1-to-string command) "\n"))
            (setq exitcode (apply 'call-process
                                  (car command)
                                  nil
                                  tfs/buffer-name
                                  nil
                                  (append (cdr command) (list tfs/login))))
            (if (equal exitcode 0)
                (let ((is-flymake-enabled
                       (and (fboundp 'flymake-mode)
                            flymake-mode)))
                  ;; disable
                  (if is-flymake-enabled
                      (flymake-mode-off))

                ;; get the checked-out version - read from the disk file
                (revert-buffer t t)

                  (if is-flymake-enabled
                      (flymake-mode-on)))

              (error "Checkout of %s was unsuccessful (%S)" buffer-file-name exitcode))))
    (error "tfs/checkout: No file")))



;; -------------------------------------------------------
;; tfs/checkin
;; performs a TFS checkin on the file being visited by the current buffer.
(defun tfs/checkin ()
  "perform a tf checkin on the file being visited by the current buffer.  Checkin happens only if the file is writable now.  This function allows you to specify a checkin comment.  It checks in only the current file being visited - pending changes for any other files will not be checked in."
  (interactive)
  (if buffer-file-name
      (if (file-writable-p buffer-file-name)
          (let* ((exitcode nil)
                 (shortname (file-name-nondirectory buffer-file-name))
                 (comment (read-string (format "Comment for %s: " shortname) nil nil nil))
                 (command (list tfs/tf-exe "checkin" (format "/comment:%s" comment)
                                buffer-file-name)))
            (tfs/append-to-message-buffer (concat "checkin " shortname ": "
                                                  (prin1-to-string command) "\n"))
            (setq exitcode (apply 'call-process
                                  (car command)
                                  nil
                                  tfs/buffer-name
                                  nil
                                  (append (cdr command) (list tfs/login))))
            (if (equal exitcode 0)
                ;; revert to the (now) readonly version
                (revert-buffer t t)
              (error "Checkin of %s was unsuccessful (%S)" buffer-file-name exitcode)))

        (error "Cannot checkin %s : the file is not writable" buffer-file-name))
    (error "tfs/checkin: No file")))



;; -------------------------------------------------------
;; tfs/rename
;; performs a TFS rename on the file being visited by the current buffer.
(defun tfs/rename ()
  "perform a tf rename on the file being visited by the current buffer.  If successful, it also renames the buffer to the new name.
"
  (interactive)
  (if buffer-file-name
      (let* (
             (exitcode nil)
             (shortname (file-name-nondirectory buffer-file-name))
             (newname (read-string (format "New name for %s: " shortname) nil nil nil))
             (command (list tfs/tf-exe "rename" shortname newname)))
        (tfs/append-to-message-buffer (concat "rename " shortname " " newname ": "
                                                  (prin1-to-string command) "\n"))
        (setq exitcode (apply 'call-process
                              (car command)
                              nil
                              tfs/buffer-name
                              nil
                              (append (cdr command) (list tfs/login))))
        (if (equal exitcode 0)
            (set-visited-file-name newname)
          (error "Rename of %s was unsuccessful (%S)" buffer-file-name exitcode)))

    (error "tfs/rename: No file")))



;; -------------------------------------------------------
;; tfs/add
;; performs a TFS add on a file
(defun tfs/add ()
  "perform a tf add on the file being visited by the current buffer."
  (interactive)
  (if buffer-file-name
      (let* ((shortname (file-name-nondirectory buffer-file-name))
             (command (list tfs/tf-exe "add" shortname))
             (exitcode nil))

        (tfs/append-to-message-buffer (concat "add " shortname ": "
                                                  (prin1-to-string command) "\n"))
        (setq exitcode (apply 'call-process
                              (car command)
                              nil
                              tfs/buffer-name
                              nil
                              (append (cdr command) (list tfs/login))))
        (if (equal exitcode 0)
            ;; TODO: make this conditional on a verbose setting
            ;; After using this package for a while, the Add is sort of
            ;; opaque. Hard to know when it's done.  It's nice to get
            ;; a confirmation message. The warm and fuzzy factor.
            (message (format "Successful add of %s" buffer-file-name))
          (error "Add of %s was unsuccessful (%S)" buffer-file-name exitcode)))

    (error "tfs/add: No file")))




;; -------------------------------------------------------
;; tfs/delete
;; performs a TFS delete on a file.
(defun tfs/delete ()
  "perform a tf delete on the file being visited by the current buffer. Kills the buffer if the delete is successful."
  (interactive)
  (if buffer-file-name
      (let ((command)
            (exitcode nil)
            (shortname (file-name-nondirectory buffer-file-name)))

        (if (y-or-n-p (concat "Really delete " shortname  "? "))
            (progn
              (setq command (list tfs/tf-exe
                                   "delete"
                                   shortname))
              (tfs/append-to-message-buffer (concat "delete " shortname ": "
                                                  (prin1-to-string command) "\n"))
              (setq exitcode (apply 'call-process
                                    (car command)
                                    nil
                                    tfs/buffer-name
                                    nil
                                  (append (cdr command) (list tfs/login))))
              (if (equal exitcode 0)
                  (kill-buffer)
                (error "Delete of %s was unsuccessful (%S)" buffer-file-name exitcode)))))
    (error "tfs/delete: No file")))




;; -------------------------------------------------------
;; tfs/get
;; performs a TFS get: retrieve a readonly copy of the specified file.
;;
(defun tfs/get ()
  "perform a tf get on the specified file. Happens only when the file is not writable. "
  (interactive)
  (if buffer-file-name
      (let ((command (list tfs/tf-exe "get" buffer-file-name))
            (exitcode nil)
            (shortname (file-name-nondirectory buffer-file-name)))
        (if (not (file-writable-p buffer-file-name))
            (progn
              ;;(tfs/prep-message-buffer)
              (tfs/append-to-message-buffer (concat "get " shortname ": "
                                                  (prin1-to-string command) "\n"))
              (setq exitcode (apply 'call-process
                                    (car command)
                                    nil
                                    tfs/buffer-name
                                    nil
                                    (append (cdr command) (list tfs/login))))
              (if (equal exitcode 0)
                  ;; get the latest version
                  (revert-buffer t t)
                (error "Get of %s was unsuccessful (%S)" buffer-file-name exitcode)))

          (error "Will not get %s : the file is writable." shortname)))
    (error "tfs/get: No file")))


;; -------------------------------------------------------
;; tfs/undo
;; performs a TFS undo: discards pending changes for the specified file. Happens only when writable.
(defun tfs/undo ()
  "perform a tf undo on the specified file. Happens only when the file is writable. Confirms before discarding edits."
  (interactive)
  (if buffer-file-name
      (let ((command (list tfs/tf-exe "undo" buffer-file-name))
            (exitcode nil)
            (shortname (file-name-nondirectory buffer-file-name)))
        (if (file-writable-p buffer-file-name)
            (if (y-or-n-p (concat "Discard current changes for " shortname  "? "))
                (progn
                  (tfs/append-to-message-buffer (concat "undo " shortname ": "
                                                  (prin1-to-string command) "\n"))
                  (setq exitcode (apply 'call-process
                                        (car command)
                                        nil
                                        tfs/buffer-name
                                        nil
                                        (append (cdr command) (list tfs/login))))
                  (if (equal exitcode 0)
                      ;; get the checked-out (reverted) version
                      (revert-buffer t t)
                    (error "undo on %s was unsuccessful (%S)"
                           buffer-file-name exitcode))))
          (error "cannot undo %s : the file is not writable" shortname)))
    (error "tfs/undo: No file")))



;; -------------------------------------------------------
;; tfs/history
;; performs a TFS history: retrieve and display the TFS history of specified file
(defun tfs/history ()
  "perform a tf history on the specified file."
  (interactive)
  (if buffer-file-name
      (let* ((command (list tfs/tf-exe "history" "/format:detailed"
                            buffer-file-name))
             (exitcode nil)
             (history-bufname (concat "*TFS-history* " buffer-file-name))
             (shortname (file-name-nondirectory buffer-file-name))
             (buffer (get-buffer-create history-bufname)))
        (save-excursion (set-buffer buffer) (erase-buffer))
        (tfs/append-to-message-buffer (concat "history " shortname ": "
                                                  (prin1-to-string command) "\n"))
        (setq exitcode (apply 'call-process
                              (car command)
                              nil
                              history-bufname
                              nil
                                  (append (cdr command) (list tfs/login))))
        (if (equal exitcode 0)
            (display-buffer history-bufname t)
          (error "tf history of %s was unsuccessful (%S)" shortname exitcode)))
    (error "tfs/history: No file")))


;; -------------------------------------------------------
;; tfs/properties
;; gets information on the file being visited by the current buffer.
;; displays that information in a new temp buffer.
(defun tfs/properties ()
  "Performs a tf properties: gets TFS properties of the current file. "
  (interactive)
  (tfs/action "properties" nil))




;; -------------------------------------------------------
;; tfs/action
;; gets information on the file being visited by the current buffer.
;; diff, properties, etc
;; displays that information in a new temp buffer.
(defun tfs/action (verb retcode)
  "Performs a tf \"action\": gets a tf query for the current file. "
  (interactive)
  (if buffer-file-name
      (let* ((command (list tfs/tf-exe verb buffer-file-name))
             (exitcode nil)
             (info-bufname (concat "*TFS-" verb "* " buffer-file-name))
             (buffer (get-buffer-create info-bufname))
             (shortname (file-name-nondirectory buffer-file-name)))
        (save-excursion (set-buffer buffer) (erase-buffer))
        (tfs/append-to-message-buffer (concat verb  shortname ": "
                                                  (prin1-to-string command) "\n"))
        (setq exitcode (apply 'call-process
                              (car command)
                              nil
                              info-bufname
                              nil
                              (append (cdr command) (list tfs/login))))

        (if (or (equal exitcode 0) (not (numberp retcode)) (equal exitcode retcode))
            (display-buffer info-bufname t)
          (error (concat "Get TFS " verb " for %s was unsuccessful (%S)")
                 buffer-file-name exitcode)))
    (error "tfs/%s: No file" verb)))



;; -------------------------------------------------------
;; tfs/annotate
(defun tfs/annotate ()
  "Gets line-by-line annotation for the file being visited by the current buffer. Displays that information in the annotation viewer. This requires the TFPT.exe tool.  See 'tfs/tfpt-exe'."
  (interactive)
  (if (file-exists-p tfs/tfpt-exe)
      (if buffer-file-name
          (let* ((exitcode nil)
                 (shortname (file-name-nondirectory buffer-file-name))
                 (command (list tfs/tfpt-exe "annotate" "/noprompt"
                                shortname))
                 (annotation-bufname (concat "*TFS annotation* " shortname))
                 (buffer (get-buffer-create annotation-bufname)))
            (save-excursion (set-buffer buffer) (erase-buffer))
            (message "computing...")
            ;;(message (apply 'concat command))
            (tfs/append-to-message-buffer (concat "annotate " shortname ": "
                                                  (prin1-to-string command) "\n"))
            (setq exitcode (apply 'call-process
                                  (car command)
                                  nil
                                  annotation-bufname
                                  nil
                                  (append (cdr command) (list tfs/login))))

            (if (equal exitcode 0)
                (progn
                  (display-buffer annotation-bufname t)
                  (beginning-of-buffer-other-window 0))

              (error "Get TFS properties for %s was unsuccessful (%S)"
                     buffer-file-name exitcode)))
        (error "tfs/annotate: No file"))
    (error "%s does not exist. (have you set tfs/tfpt-exe?)"  tfs/tfpt-exe)))


;; -------------------------------------------------------
;; tfs/thinginfo
(defun tfs/thinginfo (exe thing)
  "Gets info on a workitem or changeset. This requires the TFPT.exe tool.  See 'tfs/tfpt-exe'."
  (if (file-exists-p exe)
          (let* ((exitcode nil)
                 (guess (thing-at-point 'word))
                 (item-number (read-string (concat thing ": ")  guess nil nil))
                 (command (list exe thing item-number))
                 (bufname (concat "*TFS " thing "* " item-number))
                 (buffer (get-buffer-create bufname)))
            (save-excursion (set-buffer buffer) (erase-buffer))
            ;;(message (apply 'concat command))
            (tfs/append-to-message-buffer (concat thing " " item-number ": "
                                                  (prin1-to-string command) "\n"))
            (setq exitcode (apply 'call-process
                                  (car command)
                                  nil
                                  bufname
                                  nil
                                  (append (cdr command) (list tfs/login))))

            (if (equal exitcode 0)
                (progn
                  (display-buffer bufname t)
                  (beginning-of-buffer-other-window 0))

              (error (concat "Get TFS " thing "%s was unsuccessful (%S)"
                             item-number exitcode))))

    (error "%s does not exist. (have you set tfs/tfpt-exe or tfs/tf-exe?)"  exe)))


;; -------------------------------------------------------
;; tfs/workitem
(defun tfs/workitem ()
  "Gets info on a workitem. This requires the TFPT.exe tool.  See 'tfs/tfpt-exe'."
  (interactive)
  (tfs/thinginfo  tfs/tfpt-exe "workitem"))

;; -------------------------------------------------------
;; tfs/changeset
(defun tfs/changeset ()
  "Gets info on a changeset. This requires the TFPT.exe tool.  See 'tfs/tfpt-exe'."
  (interactive)
  (tfs/thinginfo tfs/tf-exe "changeset"))


;; -------------------------------------------------------
;; tfs/diff
;; diff on the file being visited by the current buffer.
(defun tfs/diff()
  "Performs a tf diff on the current file. "
  (interactive)
  (tfs/action "diff" 100))



;; -------------------------------------------------------
;; tfs/status
;; tf status.
(defun tfs/status ()
  "Performs a tf status. Displays the result in a buffer."
  (interactive)
  (let* ((command (list tfs/tf-exe "status"))
         (exitcode nil)
         (status-bufname  "*TFS-status*")
         (buffer (get-buffer-create status-bufname)))
    (save-excursion (set-buffer buffer) (erase-buffer))
    (tfs/append-to-message-buffer (concat "status" ": "
                                                  (prin1-to-string command) "\n"))
    (setq exitcode (apply 'call-process
                          (car command)
                          nil
                          status-bufname
                          nil
                                  (append (cdr command) (list tfs/login))))

    (if (equal exitcode 0)
        (display-buffer status-bufname t)
      (error "Get TFS status was unsuccessful (%S)" exitcode))))


(defun tfs/prep-message-buffer ()
  "scrolls the TFS Messages buffer to the end. Intended to be used by the tfs.el module internally, before appending content to the messages buffer."

  (let ((buf (current-buffer))
        (tfsbuffer (get-buffer-create tfs/buffer-name)))
    (set-buffer tfsbuffer)
    (goto-char (point-max))
    (set-buffer buf)))


(defun tfs/append-to-message-buffer (text)
  "Append text to the TFS Messages buffer.  Intended for internal use only."
  (let ((buf (current-buffer))
        (tfsbuffer (get-buffer-create tfs/buffer-name)))
    (set-buffer tfsbuffer)
    (goto-char (point-max))
    (insert text)
    (set-buffer buf)))


(provide 'tfs)