;;; p4-opened.el --- opened-file browsing commands

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

;;; Commentary:

;; This is a major mode for viewing opened files, allowing moving
;; files between changes, diffing, reverting, editing, and so on.
;;
;; Files are shown in depot syntax; in a complicated depot, these can
;; be quite long and contain a lot of redundant information.  See the
;; variable `p4-o-hidden-prefix-re'.

;;; Code:

(require 'p4)
(require 'cl)	;; remove-if-not

(defcustom p4-o-hidden-prefix-re
  "//depot/project/gow/\\(main\\|build\\)"
  "* Regular expression that matches part of a perforce filespec.
The matched portion will be hidden in the \"p4-opened\" buffer; this
is useful when your filespecs can get very long."
  :group 'p4
  :type 'string)

(defcustom p4-o-cleanup-sort-threshold 600
  "Maximum number of files to sort in `p4-opened' buffer."
  :group 'p4
  :type 'integer)

;;; ----------------------------------------------------------------------
;;; Internal vars and consts
;;; ----------------------------------------------------------------------

(defconst p4-opened-types-alist
  '((text	"txt")
    (binary	"bin")
    (symlink	"sym")
    (resource	"rsc")
    (ctext	"txt+C")
    (cxtext	"txt+Cx")
    (ktext	"txt+k")
    (kxtext	"txt+kx")
    (ltext	"txt+F")
    (tempobj	"bin+Sw")
    (ubinary	"bin+F")
    (uresource	"rsc+F")
    (uxbinary	"bin+Fx")
    (xbinary	"bin+x")
    (xltext	"txt+Fx")
    (xtempobj	"bin+Swx")
    (xtext	"txt+x"))
  "List of all the backwards-compatibility file types.")

(defconst p4-o-type-re
  "\\<\\(txt\\|bin\\|res\\|sym\\)\\(+[xwkCDFS]+\\)?"
  "Regexp describing possible file types.")

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

(defun p4-opened (&optional prompt-for-client)
  "Show all opened files in current client view.
Interactively, prefix arg will prompt for a client view."
  (interactive "P")
  (message "Finding opened files...")
  ;; using '/' for default-dir means (p4-client) will most likely
  ;; not find a P4CONFIG file, and will therefore prompt the user
  (let ((buf (format "%s" (p4-client prompt-for-client)))
	(inhibit-read-only t))
    (p4-exec-p4-fast buf "opened")

    (cond
     ((p4-re-search-buffer buf "not opened")
      (message "No files opened in client %s" (p4-client)))
     ((p4-re-search-buffer buf "Must create client")
      (message "Client %s does not exist" (p4-client)))
     (t 
      (let ((old-buf (current-buffer)))
	(set-buffer buf)
	(kill-all-local-variables)	; especially font-lock stuff
	(p4-o-cleanup-buffer)
	(p4-opened-mode)
	(p4-display-output buf)
	(select-window (get-buffer-window buf))
	(goto-char (point-min))
	(p4-o-next-line 1)
	(message "Finding opened files... done")
	(set-buffer old-buf))))))

(defun p4-o-refresh-opened-mode-buffers ()
  "Refresh all p4-opened-mode buffers."
  (mapcar 'p4-o-refresh-buffer
	  (remove-if-not
	   (lambda (b)
	     (save-excursion
	       (set-buffer b)
	       (eq major-mode 'p4-opened-mode)))
	   (buffer-list))))

(defun p4-o-refresh-buffer (b)
  ;; Regenerates the buffer contents
  (let ((obuf (current-buffer))
	(inhibit-read-only t))
    (set-buffer b)
    (or (eq major-mode 'p4-opened-mode)
	(error "Current buffer is not in p4-opened mode"))
    (erase-buffer)
    (p4-exec-p4-fast (current-buffer) "opened")
    (kill-all-local-variables)
    (if (p4-re-search-buffer (current-buffer) "not opened")
	nil
      (p4-o-cleanup-buffer)
      (p4-opened-mode)
      (goto-char (point-min))
      (p4-o-next-line 1)
      (mapcar (lambda (w)
		(set-window-start w (point-min))
		(set-window-point w (point))
		(shrink-window-if-larger-than-buffer w))
	      (get-buffer-window-list b nil t)))
    (set-buffer obuf)))
  
(defun p4-create-face (l)
  ;; l should be (face base-face bg-color fg-color)
  (let ((face (car l)))
    (copy-face (elt l 1) face)
    (if (elt l 2) (set-face-background face (elt l 2)))
    (if (elt l 3) (set-face-foreground face (elt l 3)))))

(mapcar 'p4-create-face
	'(
   ;; face		original	back		fore
   ;; -----		--------	------------	------------
   (p4-o-edit-face	default		nil		"LightSkyBlue")
   (p4-o-add-face	default		nil		"Cyan")

   (p4-o-integrate-face	p4-o-edit-face	"black"		nil )
   (p4-o-branch-face	p4-o-add-face	"black"		nil)
   ))

(defvar p4-opened-font-lock-keywords
  (cons (list p4-o-type-re 1 'font-lock-reference-face)
	'(("^..\\(defau\\)" 1 font-lock-comment-face)
	  ;("^..\\([0-9]+\\)" 1 font-lock-type-face)
	  ("\\<dele\\>" 0 'highlight)
	  ("\\<edit\\>" 0 'p4-o-edit-face)
	  ("\\<add\\>"  0 'p4-o-add-face)
	  ("\\<inte\\>" 0 'p4-o-integrate-face)
	  ("\\<bran\\>" 0 'p4-o-branch-face)
	  ("\\(.\\))" (1 font-lock-type-face)))))
	  
(defvar p4-o-change-column-map nil)	; moved here to quiet compiler
(defun p4-o-cleanup-buffer ()
  ;; Find lines like:
  ;; //depot/foo/bar#34 - edit default change (ktext) by dubois@concrete
  ;; //depot/foo/bar#34 - edit change 1032 (text+kS)
  ;; ------- 1 --------   --2-        --3-  --4--
  (goto-char (point-min))
  (while (re-search-forward "^\\(//.*#[0-9]+\\) - \\(\\sw+\\) \\sw+ \\(\\sw+\\) (\\([^)]+\\)).*$" nil 'move)
    (let ((fn (match-string-no-properties 1))
	  (action (match-string-no-properties 2))
	  (change (match-string-no-properties 3))
	  (filetype (p4-o-munge-filetype (match-string-no-properties 4)))
	  replace-text)
      (if (string= change "change") (setq change "default"))
      (setq replace-text (format "  %5s %-4s %-7s %s"
				 (substring change 0 (min 5 (length change)))
				 (substring action 0 (min 4 (length action)))
				 filetype fn))
      (put-text-property 2 7 'mouse-face 'highlight replace-text)
      (put-text-property 2 7 'local-map p4-o-change-column-map replace-text)
      (put-text-property 2 7 'change change replace-text)
      (replace-match replace-text t t)))
  (goto-char (point-max))
  (insert " ")
  (goto-char (point-min))
  (p4-o-sort)
  (p4-o-hide-cruft)
  (goto-char (point-min))
  (insert (format "  client %s:\n" (p4-client))))

(defun p4-o-munge-filetype (type)
  (save-match-data
    (let* ((type-sym (intern type))
	   (cell (assq type-sym p4-opened-types-alist)))
      (cond (cell (cadr cell))
	    ((string-match "^text" type)
	     (replace-match "txt" t t type))
	    ((string-match "^binary" type)
	     (replace-match "bin" t t type))
	    ((string-match "^resource" type)
	     (replace-match "res" t t type))
	    ((string-match "^symlink" t t type)
	     (replace-match "sym" t t type))
	    (t type)))))

(defun p4-o-hide-cruft ()
  ;; Called by p4-o-cleanup-buffer
  ;; This shortens the filespecs in the buffer, for readability
  (save-excursion
    (goto-char (point-min))
    (let (o beg)
      (while (re-search-forward p4-o-hidden-prefix-re nil t)
	(mapcar 'delete-overlay (overlays-at (match-beginning 0)))
	(setq o (make-overlay (match-beginning 0) (match-end 0)))
	(overlay-put o 'evaporate t)
	(overlay-put o 'invisible t)
	(overlay-put o 'intangible t)
	(overlay-put o 'before-string "...")))))

;;; ----------------------------------------------------------------------
;;; Idiosyncratic dired commands that don't deal with marks.
;;; ----------------------------------------------------------------------

(defun p4-o-view-change (&optional change)
  "Modify a changelist description."
  (interactive
   (list (or (p4-o-get-change)
	     (p4-o-read-change "Change to view: "))))
  (p4-change change))

(defun p4-o-move-to-filename (&optional raise-error eol)
  ;; Move point to beginning of filename on current line
  (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-o-get-change (&optional force-error)
  "Return the change on the current line, or nil if there is none.
Optional arg FORCE-ERROR raises an error instead of returning nil."
  (save-excursion
    (beginning-of-line)
    (cond ((looking-at "^.. *\\([0-9]+\\) ") (match-string-no-properties 1))
	  ((looking-at "^..\\(defau\\) ")  "default")
	  (force-error (error "Not on a line with a file."))
	  (t nil))))

(defun p4-o-get-changes ()
  ;; Return a list of all changes seen in current buffer
  (let (changes tmp)
    (save-excursion
      (goto-char (point-min))
      (while (not (eobp))
	(let ((tmp (p4-o-get-change)))
	  (and tmp (add-to-list 'changes tmp))
	  (forward-line 1))))
    (nreverse changes)))

;(defun p4-o-read-change (prompt &optional initial)
;  ;; Read a change from the user.  May return ""
;  (let ((table (mapcar 'list (p4-o-get-changes))))
;    (completing-read prompt table nil nil
;		     (if initial (cons initial 0) nil))))

(defun p4-o-read-change (prompt)
  (let ((p4-inhibit-display-shrink t))
    (p4-prompt-for-change prompt)))

(defun p4-o-sort ()
  "Sort files by their change number"
  (interactive)
  (goto-char (point-min))
  (let* ((inhibit-read-only t)
	 (line-re "^.. *\\([0-9]+\\|defa\\)")
	 beg end )
    (re-search-forward line-re)
    (beginning-of-line) (setq beg (point))
    (goto-char (point-max))
    (re-search-backward line-re)
    (forward-line 1) (setq end (point))
    (message "Sorting... ")
    (p4-o-sort-helper beg end)
    (message "Sorting... done.")
    (goto-char beg)))

;; Simple and n^2, but faster than sort.el for typical cases
;; make marker at beginning.
;; INVARIANT: All lines above this marker are sorted.
;; for each change
;;   for each line after sorted marker
;;      if line matches change, move to before sorted marker
(defun p4-o-sort-helper (beg end)
  (let ((insert-pt (set-marker (make-marker) beg))
	regexp line)
    (mapcar
     (lambda (change)
       (goto-char insert-pt)
       (setq regexp (concat "^.. *" change ".*\n"))
       (while (re-search-forward regexp nil 'move)
	 (setq line (buffer-substring (match-beginning 0) (match-end 0)))
	 (delete-region (match-beginning 0) (match-end 0))
	 (save-excursion
	   (goto-char insert-pt)
	   (insert-before-markers line))))
     (cons "defau"
	   (sort (mapcar 'string-to-number
			 (delete "default" (p4-o-get-changes)))
		 (function >))))
    (set-marker insert-pt nil)))

(defun p4-o-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")
  (forward-line arg)
  (p4-o-move-to-filename))

(defun p4-o-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")
  (forward-line (- arg))
  (p4-o-move-to-filename))

(defun p4-o-find-file-other-window (&optional other-frame)
  "In p4-opened-mode, visit this file in another window."
  (interactive "P")
  (or (file-exists-p (p4-get-client-root))
      (error "Root for `%s' doesn't exist; does it belong to another machine?"
	     (p4-client)))
  (let ((local-file (p4-depot-to-local (p4-o-get-file))))
    (or (file-exists-p local-file)
	(error "File doesn't exist"))
    (if other-frame
	(progn
	  (other-frame 1)
	  (find-file local-file))
      (find-file-other-window local-file))))

(defun p4-o-display-file ()
  "In p4-opened-mode, display this file in another window."
  (interactive)
  (or (file-exists-p (p4-get-client-root))
      (error "Client root for %s doesn't exist" (p4-client)))
  (let ((local-file (p4-depot-to-local (p4-o-get-file))))
    (or (file-exists-p local-file)
	(error "File doesn't exist"))
    (display-buffer (find-file-noselect local-file))))

(defun p4-o-quit ()
  (interactive)
  (let ((change-buf (current-buffer)))
    (delete-windows-on change-buf)
    (kill-buffer change-buf)))

(defun p4-o-summary ()
  "Summarize basic p4-o commands."
  (interactive)
  (message
   "m-ark, u-nmark, c-hange, t-ype, d-iff, R-evert, o-ther window, q-uit, h-elp"))

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

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

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

(defun p4-o-new-change ()
  "Create a new p4 changelist with the marked files.
If no files are marked, create one from files in the default changelist."
  (interactive)
  (let ((files (p4-o-get-marked-files nil))
	(change-buf (p4-change-noselect
		     "default"
		     "*Perforce new change*"))
	change)
    (save-excursion
      (set-buffer change-buf)
      (goto-char (point-min))
      (if files
	  (progn
	    (re-search-forward "^Files:")
	    (forward-line 1)
	    (delete-region (point) (point-max))
	    (mapcar (lambda (f) (insert (format "\t%s\n" f))) files)))
      (display-buffer change-buf)
      (select-window (get-buffer-window change-buf))
      (goto-char (point-min))
      (re-search-forward "^Description")
      (forward-line 1)
      (skip-chars-forward "\t "))))

(defun p4-o-revert ()
  "Revert marked files."
  (interactive)
  (let* ((files (p4-o-get-marked-files t)))
    (mapcar 'p4-revert files)
    (p4-o-refresh-opened-mode-buffers)))

(defun p4-o-move-to-change (force-prompt)
  "Move marked files to the changelist of the file at point.
If there are no files marked, move the current file.
May prompt for a destination changelist.

This may fail if Perforce doesn't like the destination you choose."
  (interactive "P")
  (let* ((files (p4-o-get-marked-files nil))
	 (marked-changes (p4-o-get-marked-changes t))
	 (change (let ((cur-change (p4-o-get-change))
		       (marked-change
			(if files
			    (save-excursion
			      (goto-char (point-min))
			      (search-forward (car files))
			      (p4-o-get-change)))))
		   (if (or (null files)
			   (string= cur-change marked-change))
		       (p4-o-read-change "Put into change: ")
		     cur-change))))
    (if (null files)
	(setq files (list (p4-o-get-file))))
    (cond ((string-match "^d" change) (setq change "default"))
	  ((string-match "^[0-9]+$" change) nil)
	  (t (error "Invalid change: %s" change)))
    (apply 'p4-exec-p4-fast
	   p4-output-buffer-name "reopen" "-c" change files)
    (p4-o-refresh-buffer (current-buffer))
    ;; warn about any changes which disappeared
    (let ((all-changes (p4-o-get-changes)))
      (mapcar (lambda (c)
		(if (and (not (string= c "default"))
			 (not (member c all-changes))
			 (y-or-n-p (format "Delete empty changelist %s? " c)))
		    (progn
		      (p4-exec-p4 nil "change" "-d" c)
		      (p4-display-output nil "Delete change" t))))
	      marked-changes))))

(defun p4-o-type ()
  "Reopen marked files with a different file type.
This may fail if Perforce does not like the type you chose (maybe?).
Refresh the display if you want to make sure it worked."
  (interactive)
  (let* ((files (p4-o-get-marked-files t))
	 (type (completing-read
		(format "Reopen %s with type: " (p4-o-filesdesc files))
		(mapcar (lambda (e) (list (symbol-name (car e)))) p4-opened-types-alist)
		nil nil '("text+k" . 0))))
    (apply 'p4-exec-p4-fast p4-output-buffer-name "reopen" "-t" type files)
    (p4-o-refresh-buffer (current-buffer))))

(defun p4-o-diff ()
  "Diff file on current line against base depot revision"
  (interactive)
  (let ((files (p4-o-get-marked-files t))
	(p4-inhibit-display-shrink t))
    (p4-diff files)))

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

(defun p4-o-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-o-move-to-filename))

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

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

(defun p4-o-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-o-unmark (- arg)))

(defun p4-o-get-file ()
  (save-excursion
    (beginning-of-line)
    (if (looking-at ".*\\(//[^# ]+\\)")
	(match-string-no-properties 1)
      (error "Not on a line with a file"))))

(defun p4-o-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-o-mark-regexp)) files)
    (save-excursion
      (goto-char (point-min))
      (while (re-search-forward re nil 'move)
	(setq files (cons (p4-o-get-file) files))))
    (setq files (nreverse files))
    (if (and (null files) use-current)
	(list (p4-o-get-file))
      files)))

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

;;; ----------------------------------------------------------------------
;;; Main mode keymap
;;; ----------------------------------------------------------------------

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

    (define-key map "c" 'p4-o-move-to-change)
    (define-key map "d" 'p4-o-diff)
    (define-key map "e" 'p4-o-view-change)
    (define-key map "h" 'p4-o-help)
    (define-key map "m" 'p4-o-mark)
    (define-key map "n" 'p4-o-next-line)
    (define-key map "N" 'p4-o-new-change)
    (define-key map "o" 'p4-o-find-file-other-window)
    (define-key map "\C-o" 'p4-o-display-file)
    (define-key map "p" 'p4-o-previous-line)
    (define-key map "q" 'p4-o-quit)
    (define-key map "r" 'p4-o-revert)
    (define-key map "t" 'p4-o-type)
    (define-key map "u" 'p4-o-unmark)
    ;; moving
    (define-key map "\C-n" 'p4-o-next-line)
    (define-key map "\C-p" 'p4-o-previous-line)

    ;;misc
    (define-key map "?" 'p4-o-summary)
    (define-key map "\177" 'p4-o-unmark-backward)

    (setq p4-opened-map map)))

;;; ----------------------------------------------------------------------
;;; Mouse keymaps and their functions
;;; ----------------------------------------------------------------------

;; keymap for the "change" column
;; moved up to quiet compiler
;;(defvar p4-o-change-column-map nil)
(if p4-o-change-column-map nil
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map p4-opened-map)
    ;; [down-mouse-1] is normally mouse-drag-region, which does a track-mouse
    ;; and eats the click event.  So we rebind it.
    (define-key map [down-mouse-1] 'mouse-set-point)
    (define-key map [mouse-1] 'p4-o-mouse-view-change)
    (setq p4-o-change-column-map map)))

(defun p4-o-mouse-view-change (e)
  (interactive "e")
  (let ((beg (posn-point (event-start e)))
	(buf (get-buffer "*Shell Command Output*"))
	num)
    (setq num (get-text-property beg 'change))
    (if (not num) (error "No change number defined at this point"))
    (p4-o-view-change num)))
    ;(shell-command (format "p4 describe -s %s" num))))

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

(put 'p4-opened-mode 'mode-class 'special)
(defun p4-opened-mode ()
  "Major mode for manipulating files opened in the current P4 client view.

You can move using the usual cursor motion commands.
Letters no longer insert themselves.  Digits are prefix arguments.
SPC and DEL can be used to move down and up by lines.

  Most commands operate on the marked files and use the current file
  if no files are marked.

Type \\[p4-o-find-file-other-window] or \\[p4-o-display-file] to display the file in another window.

Type \\[p4-o-mark] to Mark a file for later commands.
Type \\[p4-o-unmark] to Unmark a file.
Type \\[p4-o-unmark-backward] to back up one line and unmark

Type \\[p4-o-diff] to Diff a file or marked files against the depot.
Type \\[p4-o-move-to-change] to reopen a file or marked files in another Change.
Type \\[p4-o-revert] to Revert a file or marked files (querying for each).
Type \\[p4-o-type] to reopen a file or marked files with another Type.
Type \\[p4-o-help] for simple help.

You can also create, edit, and submit changelists:

Type \\[p4-o-view-change] to edit/submit a changelist.
Thpe \\[p4-o-new-change] to create a new changelist with the marked files.
  If no files are marked, this is the same as editing the default changelist.
  
Keybindings:
\\{p4-opened-map}"
  (interactive)
  (kill-all-local-variables)
  (use-local-map p4-opened-map)
  (setq major-mode 'p4-opened-mode
	mode-name "P4-Opened"
	mode-line-buffer-identification '("Opened: %11b")
	buffer-read-only t)
  (make-local-variable 'font-lock-defaults)
  (make-local-variable 'p4-opened-font-lock-keywords)
  (p4-o-hack-font-lock-keywords)
  (setq font-lock-defaults '(p4-opened-font-lock-keywords nil nil nil))
  (if (file-exists-p (p4-get-client-root))
      (setq default-directory (p4-get-client-root)))
  (set-buffer-modified-p nil)
  ;; if turn-on-font-lock loads font-lock, then this (let ...) breaks
  ;; (defvar font-lock-verbose ...)  So just require it right here.
  (require 'font-lock)
  (let ((font-lock-verbose nil))
    (turn-on-font-lock)))

(defface p4-change-face-1
  '((t (:foreground "yellow")))
  "Face used for change numbers"
  :group 'p4-faces)

(defface p4-change-face-2
  '((t (:bold t :foreground "plum")))
  "Face used for change numbers"
  :group 'p4-faces)

(defconst p4-o-change-faces
  '(p4-change-face-1
    p4-change-face-2
    font-lock-keyword-face
    font-lock-warning-face
    font-lock-type-face
    font-lock-string-face
    font-lock-constant-face))

(defun p4-o-hack-font-lock-keywords ()
  ;; Colorize dem changes differently
  (let ((i 0)
	(changes  (delete "default" (p4-o-get-changes)))
	face
	keyword)
    (while changes
      (setq face (elt p4-o-change-faces
		       (% i (length p4-o-change-faces)))
	    keyword
	    (list (format "^.. *\\(%s\\)" (car changes)) 1
		  (list 'quote face)
		  )
	    i (1+ i)
	    changes (cdr changes))
      (add-to-list 'p4-opened-font-lock-keywords keyword)
      )))