;;; 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)
# |
Change |
User |
Description |
Committed |
|
#1
|
301 |
paul_dubois |
Initial checkpoint of p4.el |
|
|