;;; p4-jobs.el --- jobs browsing commands

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

;;; Commentary:

;; This is a major mode for viewing a list of jobs.

;;; Code:

(require 'p4)
(require 'gw-utils)	;; foreach, filter

(defvar p4-jobs-font-lock-keywords
  '(("^ *\\([0-9]+\\) +\\([^ \t\n]+\\) +\\([^ \t\n]+\\)"
     (1 'font-lock-keyword-face)
     (2 'font-lock-type-face)
     (3 'font-lock-comment-face))))
	  
;;; ----------------------------------------------------------------------
;;; Creating and cleaning the p4-jobs buffer
;;; ----------------------------------------------------------------------

(defconst p4-j-expression "owner=dubois & status=open")
(defun p4-jobs (&optional prompt-for-expression)
  "Show all opened files in current client view.
Interactively, prefix arg will prompt for an expression."
  (interactive "P")
  (if (or prompt-for-expression
	  (null p4-j-expression))
      (setq p4-j-expression (read-string "Filter expression: ")))
  (message "Finding matching jobs...")
  ;; using '/' for default-dir means (p4-client) will most likely
  ;; not find a P4CONFIG file, and will therefore prompt the user
  (let ((buf "*P4 Jobs*")
	(expr p4-j-expression)
	(inhibit-read-only t))
    (if (string= expr "")
	(p4-exec-p4-fast buf "-s" "jobs")
      (p4-exec-p4-fast buf "-s" "jobs" "-e" expr))
    (if (p4-re-search-buffer buf "^error")
	(progn (pop-to-buffer buf)
	       (error "Error running p4 jobs")))
    (let ((old-buf (current-buffer)))
      (set-buffer buf)
      (kill-all-local-variables)	; especially font-lock stuff
      (goto-char (point-max))
      (forward-line -1)
      (and (looking-at "^exit") (delete-region (point) (point-max)))
      (goto-char (point-min))
      (insert "Expression: \"" expr "\"\n")
      (p4-j-cleanup-buffer)
      (p4-jobs-mode)
      (p4-display-output buf)
      (select-window (get-buffer-window buf))
      (goto-char (point-min))
      (p4-j-next-line 1)
      (message "Finding matching jobs... done")
      (set-buffer old-buf))))

(defvar p4-j-job-column-map nil)	; moved here to quiet compiler
(defun p4-j-cleanup-buffer ()
  ;; Find lines like:
  ;; info: job000003 on 2000/03/07 by dubois *open* 'This is a test '
  ;; info: job000005 on 2000/03/06 by dubois *open* 'Remove ProceduralDelta '
  ;;       --- 1 ---    ---- 2 ---    - 3 --         ---------- 4 ----------
  (goto-char (point-min))
  (if (looking-at "^Expression")
      (progn
	(put-text-property 1 11 'mouse-face 'highlight)
	(put-text-property 1 11 'local-map p4-j-job-column-map)
	(put-text-property 1 11 'command 'p4-j-set-expression)))

  (while (re-search-forward "^info: job0*\\([0-9]+\\) on ..../0?\\([^ \n\t]+\\) by \\(\\sw+\\) \\*open\\* '\\(.*\\)'" nil 'move)
    (let ((jobnum (match-string-no-properties 1))
	  (reported-date (match-string-no-properties 2))
	  (owner (match-string-no-properties 3))
	  (desc (match-string-no-properties 4))
	  replace-text)
      (setq replace-text (format "%3s %5s  %-8s %s" jobnum
				 reported-date owner desc))
      (put-text-property 0 9 'mouse-face 'highlight replace-text)
      (put-text-property 0 9 'local-map p4-j-job-column-map replace-text)
      (put-text-property 0 9 'command 'p4-j-mouse-view-job replace-text)
      (put-text-property 0 9 'job jobnum replace-text)
      (replace-match replace-text t t))))


;;; ----------------------------------------------------------------------
;;; Idiosyncratic dired commands that don't deal with marks.
;;; ----------------------------------------------------------------------

(defun p4-j-view-job (&optional job)
  "Modify a job."
  (interactive
   (list (or (p4-j-get-job)
	     (read-string "Job to view: "))))
  (p4-job job))

(defun p4-j-move-to-description ()
  ;; Move point to beginning of filename on current line
  (let ((eol (progn (end-of-line) (point))))
    (beginning-of-line)
    (if (re-search-forward "/[0-9]+ +" eol t)
	(goto-char (match-end 0)))))

(defun p4-j-get-job (&optional force-error)
  "Return the job 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))
	  (force-error (error "Not on a line with a job."))
	  (t nil))))

(defun p4-j-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-j-move-to-description))

(defun p4-j-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-j-move-to-description))

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

(defun p4-j-new-job ()
  ;; bypass the promting that p4-job does
  (interactive)
  (p4-job))

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

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

    (define-key map " " 'p4-j-view-job)
    (define-key map "n" 'p4-j-next-line)
    (define-key map "N" 'p4-j-new-job)
    (define-key map "p" 'p4-j-previous-line)
    (define-key map "q" 'p4-j-quit)

    ;; moving
    (define-key map "\C-n" 'p4-j-next-line)
    (define-key map "\C-p" 'p4-j-previous-line)
    (setq p4-jobs-map map)))

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

;; keymap for the "change" column
;; moved up to quiet compiler
;;(defvar p4-j-job-column-map nil)
(if p4-j-job-column-map nil
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map p4-jobs-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-j-mouse-execute-command)
    ;(define-key map [mouse-1] 'p4-j-mouse-view-job)
    (setq p4-j-job-column-map map)))

(defun p4-j-mouse-execute-command (e)
  (interactive "e")
  (let* ((beg (posn-point (event-start e)))
	 (cmd (get-text-property beg 'command)))
    (if (null cmd) (error "No command defined at this point"))
    (funcall cmd e)))

(defun p4-j-mouse-view-job (e)
  (interactive "e")
  (let ((beg (posn-point (event-start e)))
	(buf (get-buffer "*Shell Command Output*"))
	num)
    (setq num (get-text-property beg 'job))
    (if (not num) (error "No job number defined at this point"))
    (p4-j-view-job num)))

(defun p4-j-set-expression (e)
  (interactive "e")
  (setq p4-j-expression (read-string "New expression: "))
  (p4-jobs))

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

(put 'p4-jobs-mode 'mode-class 'special)
(defun p4-jobs-mode ()
  "Major mode for viewing a list of jobs.

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.
  
Keybindings:
\\{p4-jobs-map}"
  (interactive)
  (kill-all-local-variables)
  (use-local-map p4-jobs-map)
  (setq major-mode 'p4-jobs-mode
	mode-name "P4-Jobs"
	;;mode-line-buffer-identification '("Opened: %11b")
	buffer-read-only t)
  (make-local-variable 'font-lock-defaults)
  (make-local-variable 'p4-jobs-font-lock-keywords)
  (setq font-lock-defaults '(p4-jobs-font-lock-keywords nil nil nil))
  (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)))