p4-jobs.el #3

;;; 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#4 $

;;; Commentary:

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

;;; Code:

(require 'p4)

(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" "-r")
      (p4-exec-p4-fast buf "-s" "jobs" "-r" "-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")
      (p4-j-summary-help)
      (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))))


;;; ----------------------------------------------------------------------
;;; Commands that don't deal with marks.
;;; ----------------------------------------------------------------------

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

(defun p4-j-summary-help ()
  "Summarize basic Jobs commands."
  (interactive)
  (message
   "SPC-view job, h-help, n-ext, p-revious, N-ew job, q-uit."))

(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 ()
  "Quit and remove the job listing buffer."
  (interactive)
  (let ((change-buf (current-buffer)))
    (delete-windows-on change-buf)
    (kill-buffer change-buf)))

(defun p4-j-new-job ()
  "Create a new Perforce job."
  (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 "h" 'p4-j-help)
    (define-key map "?" 'p4-j-summary-help)
    (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.
Type \\[p4-jobs] to show this list.
Pass a prefix argument to specify your own filter expression.
Run \"p4 help jobview\" for information on filters.

You can move using the usual cursor motion commands.

Type \\[p4-j-summary-help] for simple help, \\[p4-j-help] for this help.
Type \\[p4-j-new-job] to create a new job.
Type \\[p4-j-view-job] to view a job.

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



(provide 'p4-jobs)