p4-changes-mode.el #3

;;; p4-client-mode.el --- view and describe changes

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

;;; Commentary:

;; Single user entry point -- p4-changes

;;; Code:

(require 'p4)
(require 'p4-view)

;;; ----------------------------------------------------------------------
;;; Viewing all clients (vch = view changes)
;;; ----------------------------------------------------------------------

(defvar p4-vch-current-spec nil)
(make-variable-buffer-local 'p4-vch-current-spec)

;; Entry point

(defun p4-changes (spec &optional num-changes)
  "Interactively, see changes for the passed file spec.
Prefix arg is # changes to see; default is all changes.

Non-interactively, optional argument NUM-CHANGES is the
number of changes to examine."
  (interactive (list
		(read-string "Spec: " (buffer-file-name))
		current-prefix-arg))
  (message "Finding changes...")
  (let ((old-buf (current-buffer))
	(buf (get-buffer-create "*Changes*"))
	(inhibit-read-only t)
	(args '("changes" "-i")))

    (when num-changes
      (setq num-changes (prefix-numeric-value num-changes))
      (setq args (append args (list "-m" (int-to-string num-changes)))))
    (apply 'p4-exec-p4-fast `(,buf ,@args ,spec))
    (set-buffer buf)
    (goto-char (point-min))
    (insert (format "%s change(s) for '%s':\n"
		    (if num-changes (prefix-numeric-value num-changes)
		      "all")
		    spec))
    (insert " Change  Date        User      Description
 ------  ----        ----      -----------\n")
    (p4-vch-cleanup-buffer)
    (p4-changes-mode)
    (setq p4-vch-current-spec spec)
    (p4-display-output buf)
    (select-window (get-buffer-window buf))
    (message "Finding changes... done")
    (set-buffer old-buf)))

;; Keymaps

(defvar p4-changes-mode-map nil)
(if p4-changes-mode-map nil
  (let ((map (make-keymap)))
    (suppress-keymap map)
    (define-key map [return] 'p4-vch-describe-change)
    (define-key map "h" 'p4-vch-help)
    (define-key map "n" 'next-line)
    (define-key map "p" 'previous-line)
    (define-key map "d" 'p4-vch-diff)
    (define-key map "q" 'p4-vch-quit)
    (setq p4-changes-mode-map map)))

(defvar p4-changes-column-map nil)
(if p4-changes-column-map nil
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map p4-changes-mode-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-vch-mouse-describe-change)
    (setq p4-changes-column-map map)))

(defun p4-vch-cleanup-buffer ()
  ;; Find lines like:
  ;; Change NNN on 1999/04/19 by user@client 'blabhblah'
  (goto-char (point-min))
  (let* ((ws " \\([^ ]+\\)")	;; word, saved
	 (w " [^ ]+")		;; word, not saved
	 (re (concat "^Change" ws " on" ws " by" " \\([^ @]+\\)[^ ]*" " '\\(.*\\)'")))
    (while (re-search-forward re nil 'move)
      (let ((change (string-to-int (match-string-no-properties 1)))
	    (date (match-string-no-properties 2))
	    (user (match-string-no-properties 3))
	    (desc (match-string-no-properties 4))
	    replace-text)
	(setq replace-text
	      (format "  %5d  %10s  %-8s  %s" change date user desc))
	(put-text-property 2 7 'change change replace-text)
	(put-text-property 2 7 'face 'font-lock-keyword-face replace-text)
	(put-text-property 2 7 'mouse-face 'highlight replace-text)
	(put-text-property 2 7 'local-map p4-changes-column-map replace-text)
	(replace-match replace-text t t)))
    (set-buffer-modified-p nil)))

(put 'p4-changes-mode 'mode-class 'special)
(defun p4-changes-mode ()
  "Major mode for examining changelists that affect a given filespec.
Clicking on a change number displays its description and list of
affected files.

\\[p4-vch-describe-change] to show the changelist's description.
\\[p4-vch-diff] to show the diffs of what the change did to the filespec.
\\[p4-vch-quit] to quit and kill the buffer.

Keybindings:
\\{p4-changes-mode-map}"
  (kill-all-local-variables)
  (use-local-map p4-changes-mode-map)
  (setq major-mode 'p4-changes-mode
	mode-name "P4-Changes"
	buffer-read-only t))

(defun p4-vch-quit ()
  "Kill the view-changes buffer"
  (interactive)
  (kill-buffer (current-buffer)))

(defun p4-vch-help ()
  "Give help on p4-changes mode."
  (interactive)
  (let ((minor-mode-alist nil)) (describe-mode)))

(defun p4-vch-describe-change ()
  "Describe changelist on the line at point"
  (interactive)
  (let ((buf "*Change Description*")
	change)
    (beginning-of-line)
    (skip-chars-forward " \t")
    (setq change (get-text-property (point) 'change))
    (p4-vch-view-change-low change)))
  
(defun p4-vch-diff ()
  "Show the diff2 for changelist on line at point"
  (interactive)
  (let ((buf "*P4 diff2*")
	change)
    (beginning-of-line)
    (skip-chars-forward " \t")
    (setq change (get-text-property (point) 'change))
    (p4-exec-p4 buf "diff2" p4-diff-type
		(format "%s@%d" p4-vch-current-spec (1- change))
		(format "%s@%d" p4-vch-current-spec change))
    (save-excursion
      (set-buffer buf)
      (run-hooks 'p4-diff-hook)
      (goto-char (point-min)))
    (p4-display-output buf "Diff2")))

(defun p4-vch-mouse-describe-change (e)
  "Describe changelist on the line at point"
  (interactive "e")
  (let ((beg (posn-point (event-start e)))
	change)
    (setq change (get-text-property beg 'change))
    (p4-vch-view-change-low change)))

(defun p4-vch-view-change-low (change)
  (let ((buf "*Change Description*"))
    (if (null change) (error "No change defined at this point"))
    (if (numberp change) (setq change (int-to-string change)))
    (p4-exec-p4-fast buf "describe" "-s" change)
    (p4-display-output buf)))

(provide 'p4-changes-mode)