;;; p4-update --- see what a "p4 update" would do.  With prefix arg, do it.

;; Author: Paul Du Bois <dubois@geoworks.com>
;; Maintainer: dubois@infinite-machine.com
;; $Id: //depot/tools/lisp/p4-update.el#1 $

;;; Commentary:

;; Defines commands:
;;  p4-update-current-buffer
;;  p4-update

;; This code is still a little bit experimental.  I never ended up using
;; it very much.

;;; Code:

(require 'p4)

(defun p4-update-current-buffer ()
  "Merge latest depot changes into current buffer"
  (interactive)
  (p4-buffer-sync (current-buffer))
  (let ((p4-exec-erase-buffer nil) (buf "*P4 update*"))
    (p4-erase-buffer buf)
    (p4-exec-p4-fast buf "get" (buffer-file-name))
    (p4-exec-p4-fast buf "resolve"
		     (p4-u-read-type "Update current buffer")
		     (buffer-file-name))
    (p4-display-output buf)))

;;; ----------------------------------------------------------------------
;;; Creating and cleaning the p4-update buffer
;;; ----------------------------------------------------------------------

(defun p4-update ()
  "See files (in a pretty fashion) that would be modified on a p4 update."
  (interactive)
  (message "Examining client `%s'..." (p4-client))
  (let ((out-buf "*P4 test update*") 
	(inhibit-read-only t)
	(p4-exec-erase-buffer nil))
    (p4-erase-buffer out-buf)
    (p4-exec-p4-fast out-buf "get" "-n")
    (p4-exec-p4-fast out-buf "resolve" "-n")
    (if (and (p4-re-search-buffer out-buf "up-to-date")
	     (p4-re-search-buffer out-buf "[Nn]o file(s) to resolve"))
	(progn (message "All files up to date and resolved.")
	       (p4-kill-buffer out-buf))
      (save-excursion
	(set-buffer out-buf)
	(kill-all-local-variables)	;; especially font-lock stuff
	(p4-u-cleanup-buffer)
	(set-buffer-modified-p nil)
	(p4-display-output out-buf)
	(p4-update-mode)
	(select-window (get-buffer-window out-buf))
	(goto-char (point-min))))))

(defun p4-buf-sub (n)
  (buffer-substring-no-properties (match-beginning n) (match-end n)))

(defvar p4-update-font-lock-keywords
  '(("^. \\(!resol\\|merged\\)" 1 font-lock-reference-face)
    ("^. \\(delete\\)" 1 font-lock-reference-face)
    ("^. \\(added\\|branch\\)" 1 font-lock-keyword-face)
    ("^. \\(update\\|integr\\)" 1 font-lock-function-name-face)))

(defconst p4-u-cleanups
  '(("updating" . "update")))

(defun p4-u-cleanup-buffer ()
  ;; Clean up current buffer, which should have "p4 update" output in it
  (let ((file-re "\\(//[^ \n]+\\)"))
    (goto-char (point-min))
    (flush-lines "is opened and can't be added") ; get on a branched file
    (flush-lines "^File(s) up")		; from get -n
    (flush-lines "[Nn]o file(s) to resolve")
    (flush-lines "merge from")		; don't remember what this is

    ;; Rework the lines so the action comes first
    ;;   -- action --   --------- filename#rev --------------

    ;; This is from get -n -- files that need getting and resolving
    ;; //file#x - is opened
    ;; ... //file - must resolve #x before submitting
    ;; to
    ;;   !resol //file#x
    (while (re-search-forward (concat file-re " - is opened") nil 'move)
      (replace-match "  !resol   \\1" t)
      (forward-line 1) (or (looking-at "\\.\\.\\.") (error "anomalous line"))
      (kill-line 1))

    ;; This is also from get -n.  Not so interesting.
    (goto-char (point-min))
    (while (re-search-forward "^\\(.*\\) - \\(\\(integrate\\|branch\\|delete\\) from\\|updating\\|added as\\|deleted as\\) .*$" nil t)
      (replace-match (format "  %-6s   %s"
			     (or (cdr (assoc (p4-buf-sub 2) p4-u-cleanups))
				 (substring (p4-buf-sub 2) 0 6))
			     (p4-buf-sub 1))
		     t t))

    ;; This is from resolve -n -- files that you've gotten already
    ;; but haven't resolved
    (goto-char (point-min))
    (while (re-search-forward (concat "^.* - merging " file-re ".*$")
			      nil 'move)
      (replace-match "  !resol H \\1" t))

    ;; The Dutch National Flag problem says we should be able to group
    ;; in linear time, but sorting's easier.
    (sort-lines nil (point-min) (point-max))
    (goto-char (point-min))
    (while (re-search-forward "^  !resolve \\([^ ]+\\) \\(Diff chunks.*\\)$" nil 'move)
      (replace-match "  merged   \\1\n  \\2" t))
    (goto-char (point-min))
    (insert (format "Files that need updating in client %s\n" (p4-client)))
    ;; so the window shrinks nicely
    (goto-char (point-max)) (insert " ")
    ))

;;; ----------------------------------------------------------------------
;;; Moving
;;; ----------------------------------------------------------------------

(defun p4-u-move-to-filename (&optional raise-error eol)
  (or eol (setq eol (progn (end-of-line) (point))))
  (beginning-of-line)
  (if (search-forward "//" eol t)
      (goto-char (match-beginning 0))
    (if raise-error
	(error "No file on this line"))))

(defun p4-u-next-line (arg)
  "Move down lines then position at filename.
Optional prefix ARG says how many lines to move; default is one line."
  (interactive "p")
  (next-line arg)
  (p4-u-move-to-filename))

(defun p4-u-previous-line (arg)
  "Move up lines then position at filename.
Optional prefix ARG says how many lines to move; default is one line."
  (interactive "p")
  (previous-line arg)
  (p4-u-move-to-filename))

;;; ----------------------------------------------------------------------
;;; Other/commands that don't care about marks
;;; ----------------------------------------------------------------------

(defun p4-u-read-type (prompt)
  "Return -as, -am, or -af"
  (let* ((table '(("safe" . "-as") ("moderate" . "-am") ("force" . "-af")))
	 (type
	  (completing-read
	   (format "%s merge type (safe, moderate, force): " prompt)
	   table
	   nil 'require-match '("moderate" . 0))))
    (or (cdr (assoc type table))
	(error "No merge type given."))))

(defun p4-u-update-interactive ()
  "Interactively update a file -- this will get the file as well."
  (interactive)
  (p4-exec-p4 nil "get" (p4-u-get-file))
  (p4-exec-p4-asynch nil "resolve" (p4-u-get-file)))

(defun p4-u-quit ()
  "Quit p4-update"
  (interactive)
  (kill-buffer (current-buffer))
  (condition-case nil
      (delete-window)
    (error nil)))

(defun p4-u-update-all (resolve-mode)
  "Perform a get/resolve on all files."
  (interactive (list (p4-u-read-type "Update ALL files,")))
  (let ((p4-exec-erase-buffer nil)
	(out-buf "*P4 Update*"))
    (message "Updating client `%s'..." (p4-client))
    (p4-exec-p4 out-buf "get")
    (p4-exec-p4 out-buf "resolve" resolve-mode)

    (if (p4-re-search-buffer out-buf "up-to-date")
	(progn (message "All files up to date.")
	       (p4-kill-buffer out-buf))
      (save-excursion
	(set-buffer out-buf)
	(p4-u-cleanup-buffer))
      (p4-display-output out-buf "Update: ")))

  (p4-update)
  (p4-sync-buffers))

(defun p4-u-see-change (arg)
  "For file on current line, show changelog.
Prefix arg is # changes to see."
  (interactive "P")
  (let* ((depot-file (p4-u-get-file)))
    (p4-changes arg depot-file)))

(defun p4-u-see-diff ()
  "For file on current line, show a diff of the base against the head."
  (interactive)
  (let* ((depot-file (p4-u-get-file))
	 (depot-rev (p4-u-get-revision)))
    (message "Running diff2...")
    (p4-exec-p4-fast "*P4 Diff2*" "diff2"
		     (concat depot-file "#have") (concat depot-file depot-rev))
    (save-excursion
      (set-buffer "*P4 Diff2*")
      (run-hooks 'p4-diff-hook)
      (goto-char (point-min)))
    (display-buffer "*P4 Diff2*")))

(defun p4-u-summary ()
  "Summarize basic p4-update commands."
  (interactive)
  (message
   "d-iff, U-pdate marked, update A-ll, m-ark, u-nmark, q-uit, h-elp"))

(defun p4-u-help ()
  "Give help on p4-update mode"
  (interactive)
  (let ((minor-mode-alist nil)) (describe-mode)))

;;; ----------------------------------------------------------------------
;;; Routines that work on marked files
;;; ----------------------------------------------------------------------

(defun p4-u-filesdesc (files)
  ;; helper function
  (let ((nfiles (length files)))
    (if (> nfiles 1) (format "[%s marked files]" nfiles)
      (file-name-nondirectory (car files)))))

(defun p4-u-update-some (type)
  "Get, then resolve marked files."
  (interactive (list (p4-u-read-type "Update marked files,")))
  (let* ((p4-exec-erase-buffer nil)
	 (depot-files (p4-u-get-marked-files t))
	 ;;(depot-file (p4-u-get-file))
	 )
    (p4-erase-buffer p4-output-buffer)

    (message "Getting %s..." (p4-u-filesdesc depot-files))
    (apply 'p4-exec-p4-fast
	   p4-output-buffer "get" depot-files)

    (message "Resolving %s %s..." type (p4-u-filesdesc depot-files))
    (apply 'p4-exec-p4-fast
	   p4-output-buffer "resolve" type depot-files)

    (save-excursion (set-buffer p4-output-buffer)
		    (goto-char (point-min))
		    (flush-lines "no file(s) to resolve"))
    (p4-display-output p4-output-buffer "Update:"))

  (p4-update)
  (p4-sync-buffers))

;;; ----------------------------------------------------------------------
;;; Getting, setting marks.  Mark utilities.
;;; ----------------------------------------------------------------------

;; (insert-buffer "p4-opened")
;; (goto-char (point-min))
;; (while (search-forward "p4-o" nil t) (replace-match "p4-u"))

(defun p4-u-repeat-over-lines (arg function)
  ;; This version skips non-file lines.
  (beginning-of-line)
  (while (and (> arg 0) (not (eobp)))
    (setq arg (1- arg))
    (beginning-of-line)
    (while (and (not (eobp)) (not (looking-at ".*#[0-9]+\\>")))
      (forward-line 1))
    (save-excursion (funcall function))
    (forward-line 1))
  (while (and (< arg 0) (not (bobp)))
    (setq arg (1+ arg))
    (forward-line -1)
    (while (and (not (bobp)) (not (looking-at ".*#[0-9]+$")))
      (forward-line -1))
    (beginning-of-line)
    (save-excursion (funcall function)))
  (p4-u-move-to-filename))

(defvar p4-u-mark-char ?*)
(defun p4-u-mark-regexp ()
  (concat "^" (regexp-quote (char-to-string p4-u-mark-char))))

(defun p4-u-mark (arg)
  (interactive "p")
  (let ((inhibit-read-only t))
    (p4-u-repeat-over-lines
     arg
     (function (lambda () (delete-char 1) (insert p4-u-mark-char))))))
			    
(defun p4-u-unmark (arg)
  (interactive "p")
  (let ((p4-u-mark-char ? )) (p4-u-mark arg)))

(defun p4-u-unmark-backward (arg)
  "Move up lines and remove mark there.
Optional prefix ARG says how many lines to unmark; default is one line."
  (interactive "p")
  (p4-u-unmark (- arg)))

(defun p4-u-get-file ()
  ;; Get file on current line of cleaned-up buffer
  (save-excursion
    (beginning-of-line)
    (if (looking-at ".*\\(//[^# ]+\\)")
	(p4-buf-sub 1)
      (error "Not on a line with a file"))))

(defun p4-u-get-revision ()
  ;; Get revision on current line of cleaned-up buffer
  (save-excursion
    (save-match-data
      (beginning-of-line)
      (if (looking-at ".*//[^# ]+\\(#[0-9]+\\)")
	  (p4-buf-sub 1)
	(error "Not on a line with a file")))))

(defun p4-u-get-marked-files (&optional use-current)
  "Return a list of all marked files.
If there are no marked files and USE-CURRENT is non-nil, pretend current
file is marked."
  (let ((re (p4-u-mark-regexp)) files)
    (save-excursion
      (goto-char (point-min))
      (while (re-search-forward re nil 'move)
	(setq files (cons (p4-u-get-file) files))))
    (setq files (nreverse files))
    (if (and (null files) use-current)
	(list (p4-u-get-file))
      files)))

;;; ----------------------------------------------------------------------
;;; Mode
;;; ----------------------------------------------------------------------

(defvar p4-update-map nil)
(if p4-update-map nil
  (let ((map (make-keymap)))
    (suppress-keymap map)

    (define-key map "c" 'p4-u-see-change)
    (define-key map "d" 'p4-u-see-diff)
    (define-key map "h" 'p4-u-help)
    (define-key map "i" 'p4-u-update-interactive)
    (define-key map "m" 'p4-u-mark)
    (define-key map "n" 'p4-u-next-line)
    (define-key map "p" 'p4-u-previous-line)
    (define-key map "q" 'p4-u-quit)
    (define-key map "r" 'p4-u-update-some)
    (define-key map "u" 'p4-u-unmark)

    (define-key map "M" 'p4-u-merge-current)
    (define-key map "R" 'p4-u-update-all)

    (define-key map "\C-n" 'p4-u-next-line)
    (define-key map "\C-p" 'p4-u-previous-line)

    (define-key map "?" 'p4-u-summary)
    (define-key map "\177" 'p4-u-unmark-backward)
    
    (setq p4-update-map map)))

(defun p4-update-mode ()
  "Major mode for playing with a p4-update buffer.

Type \\[p4-u-mark] to Mark a file for later commands.
  Most commands operate on the marked files and use the current file
  if no files are marked.
Type \\[p4-u-unmark] to Unmark a file.
Type \\[p4-u-unmark-backward] to back up one line and unflag.

Type \\[p4-u-see-change] to see the file's changelog.
Type \\[p4-u-see-diff] to see a diff of the file's installed changes.

Type \\[p4-u-update-all] to get/auto-resolve all files.
Type \\[p4-u-update-some] to get/auto-resolve just marked files.

Type \\[p4-u-update-interactive] to start an interactive resolve of the current file.

For get/resolve operations:
  `safe'     (-as)  Files with changes to both yours and theirs are skipped.
  `moderate' (-am)  Accept auto-merged file if there are no conflicts.
  `force'    (-af)  Accept auto-merged file even if there are conflicts.

Keybindings:
\\{p4-update-map}
"
  (kill-all-local-variables)
  (use-local-map p4-update-map)
  (setq major-mode 'p4-update-mode)
  (setq mode-name "P4-Update")
  (setq buffer-read-only t)
  (make-local-variable 'font-lock-defaults)
  (setq font-lock-defaults '(p4-update-font-lock-keywords nil nil nil))
  (if (file-exists-p (p4-get-client-root))
      (setq default-directory (p4-get-client-root)))
  ;; if turn-on-font-lock loads font-lock, then defvar font-lock-verbose loses
  (require 'font-lock)
  (let ((font-lock-verbose nil))
    (turn-on-font-lock))
  (p4-u-summary))