;;; p4-jobs.el --- jobs browsing commands ;; Author: Paul Du Bois ;; 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)