;;; p4-job-mode.el --- submit a job buffer to Perforce

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

;;; Commentary:

;; Major mode for editing and submitting jobs.  "Saving" the buffer
;; pipes it into `p4 job -i'.  Submitting it pipes it into `p4 job -i'.
;;
;; Exported routines in this file are autoloaded by p4.el.  These functions
;; are usually not called by hand; instead, use the dired-like command
;; `p4-jobs'.

;;; Code:

(require 'p4)		;; p4-executable, p4-exec-p4-fast, etc
(autoload 'p4-jm-widgetify "p4-widgets")
(autoload 'p4-jm-unwidgetify "p4-widgets")

;; copied from font-lock
(defface p4-jm-valid-keyword-face
  '((((class grayscale) (background light)) (:foreground "Gray90" :bold t))
    (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
    (((class color) (background light)) (:foreground "ForestGreen"))
    (((class color) (background dark)) (:foreground "PaleGreen"))
    (t (:bold t :underline t)))
  "Face used for valid Perforce job keywords."
  :group 'p4-faces)

(defface p4-jm-valid-keyword-face-2
  '((((class grayscale color)
      (background dark))
     (:foreground "LightPink"))
    (((class grayscale color)
      (background light))
     (:foreground "red"))
    (t 
     (:italic t)))
  "Face used for valid-but-should-be-changed Perforce job keywords."
  :group 'p4-faces)

(defcustom p4-jm-use-widgets nil
  "If non-nil, p4-job-mode uses fancy widgets.
This is still experimental."
  :group 'p4
  :type 'boolean)

(defvar p4-job-mode-hook nil
  "* Run after a buffer is put into p4-job-mode.
Hook is run before font-lock is turned on, so font-lock-defaults can be modified.")

(defvar p4-jm-tmp-file-p nil
  "If non-nil, current buffer is a tmp file created by p4.
Don't use 'p4 job -i' to submit.")
(make-variable-buffer-local 'p4-jm-tmp-file-p)

;;; ----------------------------------------------------------------------
;;; User-level commands
;;; ----------------------------------------------------------------------

(defun p4-job (&optional job)
  "View and edit Perforce job JOB.
Interactively, prompts for the job number if a prefix arg given."
  (interactive
   (list (if current-prefix-arg
	     (read-string "Job: " "new")
	   "new")))
  (let ((buffer (p4-job-noselect (or job "new"))))
    (and buffer (pop-to-buffer buffer))))

;;; ----------------------------------------------------------------------
;;; Utilities
;;; ----------------------------------------------------------------------

(defun p4-job-noselect (jobnum &optional buffer-name refresh-p)
  "Create a buffer with the contents of job JOBNUM, but do not select.
If JOBNUM is not a number (or a string number) >= 0, a new job is created.

If buffer already exists and is modified, returns that instead.
Returns the newly-created buffer, or nil on error.

Optional argument BUFFER-NAME is the name of the buffer to create.

Optional argument REFRESH-P causes buffer to be unconditionally created
fron scratch."
  (if (not (numberp jobnum)) (setq jobnum (string-to-int jobnum)))
  (let ((jobname (if (> jobnum 0) (format "job%06d" jobnum) nil)))
    (if (null buffer-name)
	(setq buffer-name
	      (if (> jobnum 0)
		  (format "*Perforce job %s*" jobnum)
		"*Perforce new job*")))

    ;; Create a buffer containing the text of the given job
    ;; returns buffer on success
    (let ((job-buf (get-buffer buffer-name)))
      (if (and (not refresh-p)
	       job-buf
	       (buffer-modified-p job-buf))
	  job-buf
	(setq job-buf (get-buffer-create buffer-name))
	(p4-exec-p4-fast job-buf "job" "-o" jobname)
	(save-excursion
	  (set-buffer job-buf)
	  (goto-char (point-min))
	  (if (re-search-forward "^Description" nil t)
	      (progn
		(forward-line 1)
		(skip-chars-forward "\t ")
		(p4-job-mode)
		(set-buffer-modified-p nil)
		(current-buffer))
	    (p4-kill-buffer job-buf)
	    nil))))))


;;; ----------------------------------------------------------------------
;;; P4 job mode
;;; ----------------------------------------------------------------------

;; this is just so font-locking comments works
(defvar p4-jm-syntax-table nil)
(if p4-jm-syntax-table
    ()
  (setq p4-jm-syntax-table (make-syntax-table))
  (modify-syntax-entry ?#  "<     " p4-jm-syntax-table)
  (modify-syntax-entry ?\n ">     " p4-jm-syntax-table))

(defvar p4-jm-map nil)
(if p4-jm-map nil
  (let ((map (make-sparse-keymap)))
    (define-key map "\C-x\C-s" 'p4-jm-save)
    (define-key map "\C-c\C-c" 'p4-jm-save-and-exit)
    (substitute-key-definition 'server-edit 'p4-jm-save-and-exit map global-map)
    (substitute-key-definition 'save-buffer 'p4-jm-save map global-map)
    (setq p4-jm-map map)))

(defvar p4-jm-font-lock-keywords
  '(("^# \\(NOTE.*\\)" 1 'p4-highlight-face t)))

(put 'p4-job-mode 'mode-class 'special)
(defun p4-job-mode (&optional tmp-file)
  "Major mode for editing a new change specification.

\\[p4-jm-save] to save your edits; \\[p4-jm-save-and-exit] to save and exit."
  ;; if TMP-FILE non-nil, we're editing a tmp file created
  ;; by the p4.  Submit with server-edit instead of "p4 job -i"
  (kill-all-local-variables)
  (set (make-local-variable 'p4-jm-tmp-file-p) (buffer-file-name))
  (set (make-local-variable 'comment-start) "#")
  (set (make-local-variable 'comment-end) "")
  (set (make-local-variable 'comment-start-skip) "#+[ \t]*")
  (set (make-local-variable 'require-final-newline) t)

  (set (make-local-variable 'buffer-quit-function)
       (lambda () (interactive)
	 (if (and (buffer-modified-p)
		  (y-or-n-p "Save changelist? "))
	     (p4-jm-save-and-exit)
	   (kill-buffer (current-buffer)))))

  (setq major-mode 'p4-job-mode
	mode-name "P4-Job"
        indent-tabs-mode t)
  (use-local-map p4-jm-map)

  (set-syntax-table p4-jm-syntax-table)

  (let ((help (substitute-command-keys
"\\[p4-jm-save-and-exit] to save and exit, \\[p4-jm-save] to save.")))
    (save-excursion
      (goto-char (point-min))
      (while (and (not (eobp)) (looking-at "^#")) (forward-line 1))
      (or (bolp) (insert "\n"))
      (insert "#\n# NOTE: This buffer is in P4-Job mode\n")
      (insert "# " help "\n")
      (set-buffer-modified-p nil))
    (message "%s" help))

  (set (make-local-variable 'font-lock-defaults)
       '(p4-jm-font-lock-keywords))

  (if p4-jm-use-widgets (p4-jm-widgetify))

  ;; run before font-lock so font-lock-defaults can be modified
  (run-hooks 'p4-job-mode-hook)
  (require 'font-lock)
  (let ((font-lock-verbose nil))
    (turn-on-font-lock)))

(defun p4-jm-save-and-exit ()
  "Give the current buffer contents to Perforce via `| p4 job -i'"
  (interactive)
  (p4-jm-save-low 'exit))

(defun p4-jm-save ()
  "Give the current buffer contents to Perforce via `| p4 job -i'"
  (interactive)
  (p4-jm-save-low nil))

(defun p4-jm-save-low (&optional exit)
  (cond
   ((not (buffer-modified-p))
    (message "(No changes need to be saved)")
    (if exit (kill-buffer (current-buffer))))
   (p4-jm-tmp-file-p
    (save-buffer)
    (if exit (server-edit)))
   (t
    (let ((args'("job" "-i")))
      (message "Saving job...")
      (if p4-jm-use-widgets (p4-jm-unwidgetify))
      (p4-erase-buffer p4-output-buffer)
      (apply 'call-process-region
       (point-min) (point-max) p4-executable nil p4-output-buffer t args)
      (let (jobnum success msg)
	(save-excursion
	  (set-buffer p4-output-buffer)
	  (goto-char (point-min))
	  (if (looking-at "Job job\\([0-9]+\\) \\(not changed\\|created\\|saved\\)")
	      (setq jobnum (int-to-string (string-to-int (match-string 1)))
		    success (match-string 2)
		    msg (match-string 0))))
	(if success
	    (progn
	      (if exit
		  (kill-buffer (current-buffer))
		(let ((oline-from-end (count-lines (point-max) (point)))
		      (ocol (current-column))
		      (wstart (window-start))
		      (cbuf (current-buffer))
		      nbuf)
		  (setq nbuf (p4-job-noselect jobnum nil t))
		  (if (not (eq cbuf nbuf))
		      (progn
			(set-window-buffer (selected-window) nbuf)
			(kill-buffer cbuf)))
		  (set-window-start (selected-window) wstart)
		  (goto-char (point-max))
		  (forward-line (- oline-from-end))
		  
		  (move-to-column ocol)))
	      (message "%s" msg))
	  (p4-display-output p4-output-buffer)))))))
	
(provide 'p4-job-mode)