;;; baz-conflicts.el --- baz conflict resolution

;; Copyright (C) 2005 Scott James Remnant <scott@netsplit.com>.

;;; Commentary:

;; A set of functions to make resolving baz conflicts easy.  Issue
;; M-x baz-conflicts and you'll get prompted for a directory, any
;; conflicted files within this project tree are then opened with the
;; smerge minor mode set and you're given a list of them in a custom mode.

;; When these files are saved, if there are no conflict markers remaining,
;; baz is informed that the conflict has been resolved and the file is
;; removed from the list.

;;; Code:

(defvar baz-conflict-list ())

(defun baz-conflicts (path)
  "Open conflicted files under PATH.
Each file is opened in a buffer of its own with the smerge minor mode set
so the conflicts can be resolved simply.

The current buffer is set to the buffer menu so the list of open buffers
can be easily iterated."
  (interactive "D")
  (let ((tree-root (Baz-tree-root path)))
    (let ((conflicted
	   (with-output-to-string
	     (with-current-buffer standard-output
	       (call-process "baz" nil t nil
			     "status" "--conflicted" tree-root)))))

      (dolist (line (split-string conflicted "\n"))
	(when (string= (substring line 0 4) " C  ")
	  (let (conflict b)
	    (setq conflict (concat tree-root (substring line 4)))
	    (setq b (find-file-noselect conflict))
	    
	    (with-current-buffer b
	      (revert-buffer nil t)
	      (smerge-mode))

	    (add-to-list 'baz-conflict-list b))))))

  (baz-conflict-menu))


(defun Baz-tree-root (path)
  "Return the baz tree root for PATH or error if there isn't one"
  (let ((shell-path (shell-quote-argument (expand-file-name path))))
    (file-name-as-directory
     (substring
      (with-output-to-string
	(with-current-buffer standard-output
	  (when (/= 0 (call-process "baz" nil t nil "tree-root" shell-path))
	    (error "Not a baz project tree: %s" path)))) 0 -1))))


(defun Baz-resolve-conflict ()
  "Called when a conflicting file is saved.
If all of the conflicts in the file have been resolved, baz is informed
of the resolution and the file is removed from the conflict list."
  (let ((b (current-buffer)))
    (when (memq b baz-conflict-list)
      (save-excursion
	(beginning-of-buffer)
	(if (re-search-forward "^<<<<<<< TREE" nil t)
	    (progn
	      (message "Conflict markers still remain in this file.")
	      (ding))
	  (progn
	    (setq baz-conflict-list (delq b baz-conflict-list))
	    (list-baz-conflict-buffers-noselect)

	    ;; clear the baz status
	    (let ((shell-path (shell-quote-argument (buffer-file-name b)))
		  baz-output)
	      (setq baz-output (with-output-to-string
				 (with-current-buffer standard-output
				   (call-process "baz" nil t nil
						 "resolved" shell-path))))
	      (message (substring baz-output 0 -1)))))))))

(add-hook 'after-save-hook 'Baz-resolve-conflict)


(defun Baz-remove-conflict ()
  "Called when a buffer is killed to remove it from the conflict list.
Does nothing to tell baz whether or not it's resolved."
  (when (memq (current-buffer) baz-conflict-list)
    (setq baz-conflict-list (delq (current-buffer) baz-conflict-list))
    (list-baz-conflict-buffers)))

(add-hook 'kill-buffer-hook 'Baz-remove-conflict)


;;; Major Mode:

;; This is a major mode for listing the currently conflicting buffers
;; almost entirely cargo-culted from buff-menu.el

(defvar Baz-conflict-menu-mode-map nil "")

(if Baz-conflict-menu-mode-map
    ()
  (setq Baz-conflict-menu-mode-map (make-keymap))
  (suppress-keymap Baz-conflict-menu-mode-map t)
  (define-key Baz-conflict-menu-mode-map "q" 'quit-window)
  (define-key Baz-conflict-menu-mode-map "f" 'Baz-conflict-menu-this-window)
  (define-key Baz-conflict-menu-mode-map "e" 'Baz-conflict-menu-this-window)
  (define-key Baz-conflict-menu-mode-map "\C-m" 'Baz-conflict-menu-this-window)
  (define-key Baz-conflict-menu-mode-map "o" 'Baz-conflict-menu-other-window)
  (define-key Baz-conflict-menu-mode-map "g" 'Baz-conflict-menu-revert)
  (define-key Baz-conflict-menu-mode-map " " 'next-line)
  (define-key Baz-conflict-menu-mode-map "n" 'next-line)
  (define-key Baz-conflict-menu-mode-map "p" 'previous-line)
  (define-key Baz-conflict-menu-mode-map "?" 'describe-mode)
  )

(put 'Baz-conflict-menu-mode 'mode-class 'special)

(defun Baz-conflict-menu-mode ()
  "Major mode for showing list of conflicted files.
Each line describes ones of the buffers in Emacs for which there is
an open baz conflict.
Letters do not insert themselves; instead, they are commands.
\\<Baz-conflict-menu-mode-map>
\\[Baz-conflict-menu-this-window] -- select current line's buffer.
\\[Baz-conflict-menu-other-window] -- select that buffer in another window.
\\[Baz-conflict-menu-revert] -- update the list of buffers."
  (kill-all-local-variables)
  (use-local-map Baz-conflict-menu-mode-map)
  (setq major-mode 'Baz-conflict-menu-mode)
  (setq mode-name "Baz Conflict Menu")
  (setq revert-buffer-function 'Baz-conflict-menu-revert-function)
  (setq truncate-lines t)
  (setq buffer-read-only t))

(defun Baz-conflict-menu-revert ()
  "Update the list of conflicted buffers."
  (interactive)
  (revert-buffer))

(defun Baz-conflict-menu-revert-function (ignore1 ignore2)
  (list-baz-conflict-buffers))

(defun Baz-conflict-menu-buffer (error-if-non-existent-p)
  "Return buffer described by this line of baz conflict menu."
  (let* ((where (save-excursion
		  (beginning-of-line)
		  (+ (point) 1)))
	 (name (and (not (eobp)) (get-text-property where 'buffer-name)))
	 (buf (and (not (eobp)) (get-text-property where 'buffer))))
    (if name
	(or (get-buffer name)
	    (and buf (buffer-name buf) buf)
	    (if error-if-non-existent-p
		(error "No buffer named `%s'" name)
	      nil))
      (or (and buf (buffer-name buf) buf)
	  (if error-if-non-existent-p
	      (error "No buffer on this line")
	    nill)))))

(defun baz-conflict-menu ()
  "Make a menu of baz conflict buffers so you can select them.
Type ? after invocation to get help on commands available.
Type q immediately to make the buffer menu go away."
  (interactive)
  (switch-to-buffer (list-baz-conflict-buffers-noselect)))

(defun baz-conflict-menu-other-window ()
  "Display a list of baz conflict buffers in another window.
With the baz conflict buffer list buffer you can select buffers.
Type ? after invocation to get help on commands available.
Type q immediately to make the buffer menu go away."
  (interactive)
  (switch-to-buffer-other-window (list-baz-conflict-buffers-noselect)))


(defun Baz-conflict-menu-this-window ()
  "Select this line's buffer in this window."
  (interactive)
  (switch-to-buffer (Baz-conflict-menu-buffer t)))

(defun Baz-conflict-menu-other-window ()
  "Select this line's buffer in another window, leaving menu visible."
  (interactive)
  (switch-to-buffer-other-window (Baz-conflict-menu-buffer t)))


(defun list-baz-conflict-buffers ()
  "Display a list of names of existing baz conflict buffers.
The list is displayed in a buffer named `*Baz Conflicts*'."
  (interactive)
  (display-buffer (list-baz-conflict-buffers-noselect)))

(defun list-baz-conflict-buffers-noselect ()
  "Create and return a buffer with a list of names of existing baz conflict buffers.
The buffer is named `*Baz Conflicts*'."
  (let ((old-buffer (current-buffer))
	(standard-output standard-output)
	desired-point)
    (save-excursion
      (set-buffer (get-buffer-create "*Baz Conflicts*"))
      (setq buffer-read-only nil)
      (erase-buffer)
      (setq standard-output (current-buffer))
      (princ "\
These buffers have current baz conflicts; to clear the conflict, resolve
and save it.

 Buffer           Size  Mode         File
 ------           ----  ----         ----
")
      (dolist (buffer baz-conflict-list)
	(let ((name (buffer-name buffer))
	      (file (buffer-file-name buffer))
	      (this-buffer-size (buffer-size buffer))
	      this-buffer-mode-name
	      this-buffer-line-start)
	  (with-current-buffer buffer
	    (setq this-buffer-mode-name mode-name))
	  ;; Identify current buffer like the buffers menu does
	  (if (eq buffer old-buffer)
	      (progn
	       (setq desired-point (point))
	       (princ "."))
	    (princ " "))
	  (setq this-buffer-line-start (point))
	  (princ name)
	  ;; Put the buffer name into a text property so we don't have
	  ;; to extract it
	  (let ((name-end (point)))
	    (indent-to 14 2)
	    (put-text-property this-buffer-line-start name-end
			       'buffer-name name)
	    (put-text-property this-buffer-line-start (point)
			       'buffer buffer))
	  (let ((size (format "%8d" this-buffer-size))
		(mode this-buffer-mode-name)
		(excess (- (current-column) 14)))
	    (while (and (> excess 0) (= (aref size 0) ?\ ))
	      (setq size (substring size 1)
		    excess (1- excess)))
	    (princ size)
	    (indent-to 24 1)
	    (princ mode))
	  (indent-to 37 1)
	  (princ (abbreviate-file-name file))
	  (princ "\n")))
      (Baz-conflict-menu-mode)
      (and desired-point
	   (goto-char desired-point))
      (current-buffer))))


;;; baz-conflicts.el ends here