;;; p4-change-mode.el --- submit a changelist buffer to Perforce

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

;;; Commentary:

;; Major mode for editing and submitting changelists.  "Saving" the buffer
;; pipes it into `p4 change -i'.  Submitting it pipes it into `p4 submit -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-opened'.

;;; Code:

(require 'p4)		;; p4-executable, p4-exec-p4-fast, etc

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

(autoload 'p4-o-refresh-opened-mode-buffers "p4-opened")

(defun p4-change (&optional change)
  "View and edit Perforce changelist CHANGE.
Interactively, prompts for the changelist if prefix arg given,
or if there is no change associated with the current buffer."
  (interactive
   (list
    (if current-prefix-arg
	(read-string "Change: ")
      (let ((buf-change (p4-cm-buffer-change)))
	(if buf-change buf-change (read-string "Change: "))))))
  (if (numberp change) (setq change (number-to-string change)))
  (let ((buffer (p4-change-noselect change)))
    (and buffer (pop-to-buffer buffer))))

(defun p4-cm-buffer-change ()
  "Return the pending change number associated with the current buffer,
or nil if the buffer is not visiting an opened file."
  (save-match-data
    (let ((obuf (get-buffer-create " *changetmp*")))
      (p4-exec-p4 obuf "opened" (buffer-file-name))
      (prog1
	  (cond ((p4-re-search-buffer obuf " - \\sw+ change \\([0-9]+\\)")
		 (save-excursion (set-buffer obuf) (match-string 1)))
		((p4-re-search-buffer obuf " - \\sw+ default change")
		 "default")
		(t nil))
	(kill-buffer obuf)))))

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

(defvar p4-cm-no-submit-regexp "do not submit"
  "Regexp used to prevent inadvertent submission of `holding' changelists.")

(defun p4-change-noselect (change &optional buffer-name refresh-p)
  "Create a buffer with the contents of changelist CHANGE, but do not select.
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."
  (or buffer-name
      (setq buffer-name
	    (if (string= change "default")
		"*Perforce default change*"
	      (format "*Perforce change %s*" change))))

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

;;; ----------------------------------------------------------------------
;;; P4 change mode
;;; ----------------------------------------------------------------------

(defvar p4-cm-change-committed-p nil
  "If non-nil, change in current buffer has already been committed.
This variable is automatically made buffer-local when set in any manner.")
(make-variable-buffer-local 'p4-cm-change-committed-p)

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

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

(defvar p4-cm-font-lock-keywords
  '(("^\\(Jobs\\|Change\\|Files\\|Date\\|Client\\|User\\|Status\\|Description\\):"
     1 font-lock-keyword-face)
    ("^# \\(NOTE.*\\)" 1 'p4-highlight-face t)))

(put 'p4-change-mode 'mode-class 'special)
(defun p4-change-mode ()
  "Major mode for editing a new change specification.

\\[p4-cm-save] to save your edits; \\[p4-cm-save-and-exit] to save and exit.
\\[p4-cm-submit] to actually submit the changelist to the depot."
  ;(interactive)
  (kill-all-local-variables)
  (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)

  (save-excursion
    (goto-char (point-min))
    (setq p4-cm-change-committed-p
	  (re-search-forward "^Status:\\s-+submitted" nil t)))

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

  (setq major-mode 'p4-change-mode
	mode-name "P4-Change"
        indent-tabs-mode t)
  (use-local-map p4-cm-map)

  (set-syntax-table p4-cm-syntax-table)
  (set (make-local-variable 'font-lock-defaults)
       '(p4-cm-font-lock-keywords))

  (require 'font-lock)
  (let ((font-lock-verbose nil))
    (turn-on-font-lock))

  (let ((help (substitute-command-keys
"\\[p4-cm-save-and-exit] to save and exit, \\[p4-cm-save] to save, \\[p4-cm-submit] to SUBMIT.")))
    (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-Change mode\n")
      (insert "# " help "\n")
      (set-buffer-modified-p nil))
    (message "%s" help)))

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

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

(defun p4-cm-save-low (&optional exit)
  (cond
   ((not (buffer-modified-p))
    (message "(No changes need to be saved)")
    (if exit (kill-buffer (current-buffer))))
   ((and p4-cm-change-committed-p
	 (not (y-or-n-p "Change already committed... really save? ")))
    (message "Save aborted."))
   (t
    (let (msg args)
      (if p4-cm-change-committed-p
	  (setq msg  "Saving committed changelist as root..."
		args '("-u" "root" "change" "-f" "-i"))
	(setq msg  "Saving changelist..."
	      args '("change" "-i")))
      (message "%s" msg)

      (p4-erase-buffer p4-output-buffer)
      (apply 'call-process-region
       (point-min) (point-max) p4-executable nil p4-output-buffer t args)
      (let (changenum success msg)
	(save-excursion
	  (set-buffer p4-output-buffer)
	  (goto-char (point-min))
	  (if (looking-at "Change \\([0-9]+\\) \\(created\\|updated\\)")
	      (setq changenum (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-change-noselect changenum 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)))
	      (if (and (string= success "created")
		       (fboundp 'p4-o-refresh-opened-mode-buffers))
		  (p4-o-refresh-opened-mode-buffers))
	      (message "%s" msg))
	  (p4-display-output p4-output-buffer)))))))
	
(defun p4-cm-submit ()
  "Submit the current buffer changelist to Perforce via `| p4 submit -i'"
  (interactive)
  (if (and (save-excursion
	     (goto-char (point-min))
	     (re-search-forward p4-cm-no-submit-regexp nil t))
	   (not (yes-or-no-p "Change says do not submit... really submit? ")))
      (message "Submit aborted.")
    (message "Submitting changelist...")
    (save-window-excursion
      (p4-erase-buffer p4-output-buffer)
      (display-buffer (get-buffer-create p4-output-buffer))
      (call-process-region
       (point-min) (point-max) p4-executable nil p4-output-buffer t
       "submit" "-i"))
    (let (success msg)
      (save-excursion
	(set-buffer p4-output-buffer)
	(goto-char (point-min))
	(if (re-search-forward "^Change [0-9]+.*submitted" nil t)
	    (setq success t
		  msg (match-string 0))))
      (if success
	  (progn
	    (kill-buffer (current-buffer))
	    (if (fboundp 'p4-o-refresh-opened-mode-buffers)
		(p4-o-refresh-opened-mode-buffers))
	    (p4-sync-buffers)
	    (message "%s" msg))
	(p4-display-output p4-output-buffer)))))

(provide 'p4-change-mode)