;;; 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))