Initial version of Emacs 21 VC support for Perforce.
[git-p4: depot-paths = "//guest/Ben_Key/vc-p4/,//guest/jonathan_kamens/vc-p4/,//guest/magnus_henoch/vc-p4/": change = 1213]
This commit is contained in:
Jonathan Kamens
commit
b69b02ad08
2 changed files with 1425 additions and 0 deletions
680
p4-lowlevel.el
Normal file
680
p4-lowlevel.el
Normal file
|
|
@ -0,0 +1,680 @@
|
|||
;;; p4-lowlwevel.el --- low-level support for Perforce operations in Emacs
|
||||
|
||||
;; Copyright (C) 2002 Curl Corporation.
|
||||
|
||||
;; Author: Jonathan Kamens <jik@kamens.brookline.ma.us>
|
||||
;; Maintainer: Jonathan Kamens <jik@kamens.brookline.ma.us>
|
||||
|
||||
;; $Id$
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 2, or (at your option)
|
||||
;; any later version.
|
||||
;;
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program; if not, you can either send email to this
|
||||
;; program's maintainer or write to: The Free Software Foundation,
|
||||
;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file provides an Emacs-lisp interface to the Perforce client
|
||||
;; functionality which is necessary to implement support for Perforce
|
||||
;; in Emacs VC mode.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defgroup p4-lowlevel nil
|
||||
"Emacs-lisp interface to Perforce operations."
|
||||
:group 'tools)
|
||||
|
||||
(defcustom p4-lowlevel-p4-program "p4"
|
||||
"*The `p4' program to run to execute Perforce commands."
|
||||
:type 'string
|
||||
:group 'p4-lowlevel)
|
||||
|
||||
(defcustom p4-lowlevel-diff-switches '("-du")
|
||||
"*The flags to use when calling `p4 diff' or `p4 diff2'."
|
||||
:type '(choice (const :tag "None" nil)
|
||||
(repeat :tag "Argument List"
|
||||
:value ("")
|
||||
string))
|
||||
:group 'p4-lowlevel)
|
||||
|
||||
(defcustom p4-lowlevel-command-messages nil
|
||||
"*If non-nil, display run messages from P4 commands.
|
||||
If vc-command-messages is bound and non-nil, it does the same thing."
|
||||
:type 'boolean
|
||||
:group 'p4-lowlevel)
|
||||
|
||||
(defun p4-lowlevel-command-to-buffer (args &optional input output)
|
||||
"Call `p4-lowlevel-p4-command' with specified list of ARGS.
|
||||
ARGS can be a list or a single string argument. Do not specify the
|
||||
`-s' argument to p4; it is always specified by this function. The
|
||||
remaining arguments are optional. If INPUT is non-nil, it is a buffer
|
||||
or file to use as input. If OUTPUT is non-nil, it is a buffer in
|
||||
which to insert the command's output at point; otherwise, a temporary
|
||||
buffer is created.
|
||||
|
||||
If the p4 invocation is unsuccessful, checks to make sure there's an
|
||||
`exit:' line at the end of the output with a non-zero value in it; if
|
||||
not, it adds such a line containing either the non-zero exit status or
|
||||
the signal information from `call-process', after deleting any
|
||||
previous `exit: 0' line (which shouldn't be there since the
|
||||
`call-process' failed).
|
||||
|
||||
Returns the buffer containing the program output."
|
||||
(if (stringp args)
|
||||
(setq args (list args)))
|
||||
(let* (apply-args p4-args call-func string-command exit-status
|
||||
(temp-name " *p4-lowlevel-output*")
|
||||
(output-buffer (or output (p4-lowlevel-get-buffer-create temp-name)))
|
||||
(my-default-directory default-directory))
|
||||
(save-excursion
|
||||
(set-buffer output-buffer)
|
||||
(while (and my-default-directory
|
||||
(not (file-exists-p my-default-directory))
|
||||
(not (string= "" my-default-directory)))
|
||||
(setq my-default-directory
|
||||
(file-name-as-directory
|
||||
(file-name-directory (directory-file-name
|
||||
my-default-directory)))))
|
||||
(if (not (file-exists-p my-default-directory))
|
||||
(setq my-default-directory "/"))
|
||||
(erase-buffer)
|
||||
(if (bufferp input)
|
||||
(progn (set-buffer input)
|
||||
(setq call-func 'call-process-region)
|
||||
(setq apply-args (list (point-min) (point-max)
|
||||
p4-lowlevel-p4-program nil)))
|
||||
(setq call-func 'call-process)
|
||||
(setq apply-args (list p4-lowlevel-p4-program input)))
|
||||
(setq p4-args (append (list "-s") args))
|
||||
(if (p4-lowlevel-command-messages)
|
||||
(progn (setq string-command
|
||||
(mapconcat (lambda (s) s)
|
||||
(append (list p4-lowlevel-p4-program)
|
||||
p4-args) " "))
|
||||
(message "Running %s..." string-command)))
|
||||
(let ((default-directory my-default-directory))
|
||||
(setq exit-status (apply call-func
|
||||
(append apply-args (list output-buffer nil)
|
||||
p4-args))))
|
||||
(if (p4-lowlevel-command-messages)
|
||||
(message "Running %s... exit %s" string-command exit-status))
|
||||
(if (and (numberp exit-status) (zerop exit-status)) t
|
||||
(set-buffer output-buffer)
|
||||
(goto-char (point-max))
|
||||
(forward-line -1)
|
||||
(if (looking-at "^exit: [^0]") t
|
||||
(if (looking-at "^exit:")
|
||||
(kill-line 1)
|
||||
(goto-char (point-max))
|
||||
(or (looking-at "^") (insert "\n")))
|
||||
(insert "exit: ")
|
||||
(if (numberp exit-status)
|
||||
(insert (format "%d" exit-status))
|
||||
(insert exit-status))
|
||||
(insert "\n")))
|
||||
output-buffer)))
|
||||
|
||||
(defun p4-lowlevel-buffer-to-alist (&optional buffer)
|
||||
"Converts the current buffer containing p4 output to an alist. If
|
||||
optional argument BUFFER is non-nil, converts that buffer instead.
|
||||
The returned alist contains one element for each `unit' in the buffer.
|
||||
A `unit' is either a line containing a tag (`info:' or `info#:',
|
||||
`error:', `exit:', etc.) or a block of untagged text. The car of each
|
||||
element is the tag for the line (i.e., the string to the left of the
|
||||
colon, or `text' for text units), and the cdr is the value for the
|
||||
line (i.e., everything after the first `: ' sequence) or the entire
|
||||
block of untagged text (including newlines other than the last one).
|
||||
The alist is in the same order as the contents of the buffer."
|
||||
(save-excursion
|
||||
(if buffer (set-buffer buffer))
|
||||
(let (alist tag value
|
||||
(last-match-end (point-min)))
|
||||
(goto-char last-match-end)
|
||||
(while (re-search-forward "^\\([A-Za-z0-9]+\\): \\(.*\\)" nil t)
|
||||
(if (not (= (match-beginning 1) last-match-end))
|
||||
(progn (setq tag "text"
|
||||
value (buffer-substring last-match-end
|
||||
(- (match-beginning 1) 1))
|
||||
alist (cons (cons tag value) alist))))
|
||||
(setq tag (match-string 1)
|
||||
value (match-string 2)
|
||||
alist (cons (cons tag value) alist)
|
||||
last-match-end (+ (match-end 2) 1)))
|
||||
(if (not (= last-match-end (point-max)))
|
||||
(progn (setq tag "text"
|
||||
value (buffer-substring last-match-end
|
||||
(- (point-max) 1))
|
||||
alist (cons (cons tag value) alist))))
|
||||
(nreverse alist))))
|
||||
|
||||
(defun p4-lowlevel-command-to-alist (args &optional input)
|
||||
"Calls `p4-lowlevel-command-to-buffer' and then
|
||||
`p4-lowlevel-buffer-to-alist'. Passes ARGS and optional INPUT to
|
||||
`p4-lowlevel-command-to-buffer'. Hands the resulting buffer to
|
||||
`p4-lowlevel-buffer-to-alist' for parsing. Kills the output buffer
|
||||
when it has been parsed. Returns the resulting alist on success, or
|
||||
the return value of `p4-lowlevel-command-to-buffer' on failure."
|
||||
(let ((output-buffer (p4-lowlevel-command-to-buffer args input))
|
||||
return-value)
|
||||
(setq return-value (p4-lowlevel-buffer-to-alist output-buffer))
|
||||
(kill-buffer output-buffer)
|
||||
return-value))
|
||||
|
||||
(defun p4-lowlevel-re-assoc (key alist)
|
||||
"Get elements matching regexp KEY in ALIST, or nil if none."
|
||||
(let (element matching-alist)
|
||||
(while alist
|
||||
(setq element (car alist)
|
||||
alist (cdr alist))
|
||||
(if (string-match key (car element))
|
||||
(setq matching-alist (cons element matching-alist))))
|
||||
(nreverse matching-alist)))
|
||||
|
||||
(defun p4-lowlevel-successful-alist-p (output)
|
||||
"Determines if OUTPUT, a buffer or alist, is from a successful p4 command.
|
||||
Does this by confirming that OUTPUT is a buffer or alist, that there
|
||||
are no `error' keys in it, and that its `exit' element (if any) has a
|
||||
value of 0."
|
||||
(if (bufferp output)
|
||||
(setq output (p4-lowlevel-buffer-to-alist output)))
|
||||
(if (not (listp output))
|
||||
nil
|
||||
(let ((element (assoc "exit" output)))
|
||||
(if (not (or (not element) (equal (cdr element) "0")))
|
||||
nil
|
||||
(if (p4-lowlevel-re-assoc "^error" output)
|
||||
nil
|
||||
t)))))
|
||||
|
||||
(defun p4-lowlevel-items-matching-tag (tag output)
|
||||
"Returns a list of the items maching TAG in p4 OUTPUT, or nil if none.
|
||||
OUTPUT may be a buffer or alist."
|
||||
(if (bufferp output)
|
||||
(setq output (p4-lowlevel-buffer-to-alist output)))
|
||||
(mapcar (lambda (pair) (cdr pair)) (p4-lowlevel-re-assoc tag output)))
|
||||
|
||||
(defun p4-lowlevel-lines-matching-tag (tag output)
|
||||
"Returns a string containing the lines matching TAG in p4 OUTPUT, or
|
||||
nil if none. OUTPUT may be a buffer or alist. The lines are
|
||||
terminated by newlines. The tags are not included in the string."
|
||||
(if (bufferp output)
|
||||
(setq output (p4-lowlevel-buffer-to-alist output)))
|
||||
(let* ((alist (p4-lowlevel-re-assoc tag output))
|
||||
(lines (apply 'concat
|
||||
(apply 'append
|
||||
(mapcar (lambda (pair)
|
||||
(list (cdr pair) "\n")) alist)))))
|
||||
(if (equal lines "")
|
||||
nil
|
||||
lines)))
|
||||
|
||||
(defun p4-lowlevel-errors (output)
|
||||
"Returns a string containing the errors in p4 OUTPUT, or nil if none.
|
||||
OUTPUT may be a buffer or alist. The error lines are separated by
|
||||
newlines, but there is no ending newline on the string."
|
||||
(let ((errors (p4-lowlevel-lines-matching-tag "^error" output)))
|
||||
(if errors
|
||||
(substring errors 0 -1)
|
||||
nil)))
|
||||
|
||||
(defun p4-lowlevel-info-lines (output)
|
||||
"Returns a string containing the info in p4 OUTPUT, or nil if none.
|
||||
OUTPUT may be a buffer or alist. The info lines are terminated by
|
||||
newlines."
|
||||
(p4-lowlevel-lines-matching-tag "^info" output))
|
||||
|
||||
(defun p4-lowlevel-text (output)
|
||||
"Returns a string containing the text in p4 OUTPUT, or nil if none.
|
||||
OUTPUT may be a buffer or alist. The text lines are terminated by
|
||||
newlines."
|
||||
(p4-lowlevel-lines-matching-tag "^text" output))
|
||||
|
||||
(defun p4-lowlevel-command-or-error (args &optional input output-format noerror)
|
||||
"Executes p4 command specified by ARGS and returns output or signals error.
|
||||
Pass optional argument INPUT to `p4-lowlevel-command-to-buffer'. If optional
|
||||
argument OUTPUT-FORMAT is \'string, return a string containing the
|
||||
output (including tags). If it is \'buffer, return the temporary
|
||||
buffer containing the output. If it is a buffer, put output in that
|
||||
buffer and return it. If it is anything else, return an alist of the
|
||||
output. If optional fourth argument NOERROR is true, then returns nil
|
||||
rather than raising an error."
|
||||
(let* (errors error-buffer return-value
|
||||
(output-buffer (p4-lowlevel-command-to-buffer args input
|
||||
(if (bufferp output-format)
|
||||
output-format)))
|
||||
(output-alist (p4-lowlevel-buffer-to-alist output-buffer)))
|
||||
(if (p4-lowlevel-successful-alist-p output-alist) t
|
||||
(setq errors (or (p4-lowlevel-errors output-alist) "Unknown error"))
|
||||
(kill-buffer output-buffer)
|
||||
(or noerror
|
||||
(if (not (string-match "\n" errors))
|
||||
(error "P4 error: %s" errors)
|
||||
(setq error-buffer (p4-lowlevel-get-buffer-create
|
||||
" *p4-lowlevel-error*"))
|
||||
(set-buffer error-buffer)
|
||||
(erase-buffer)
|
||||
(insert errors)
|
||||
(goto-char (point-min))
|
||||
(pop-to-buffer error-buffer nil t)
|
||||
(resize-temp-buffer-window)
|
||||
(error ""))))
|
||||
(cond
|
||||
(errors (setq return-value nil))
|
||||
((eq output-format 'string)
|
||||
(save-excursion (set-buffer output-buffer)
|
||||
(setq return-value (buffer-string)))
|
||||
(kill-buffer output-buffer))
|
||||
((or (eq output-format 'buffer) (bufferp output-format))
|
||||
(setq return-value output-buffer))
|
||||
(t (setq return-value output-alist)
|
||||
(kill-buffer output-buffer)))
|
||||
return-value))
|
||||
|
||||
(defun p4-lowlevel-command-into-buffer (args buffer)
|
||||
"Executes p4 command specified by ARGS, raising errors when necessary.
|
||||
If BUFFER is a string, then puts output in buffer whose name is formed
|
||||
by concatenating ` *p4-lowevel-', BUFFER-NAME, and `*' (e.g., if BUFFER is
|
||||
`diff', then output goes in buffer ` *p4-lowevel-diff*'). If BUFFER is a
|
||||
buffer, then puts output in that buffer. Returns the buffer."
|
||||
(let* ((output-alist (p4-lowlevel-command-or-error args))
|
||||
(output-buffer (if (bufferp buffer) buffer
|
||||
(p4-lowlevel-get-buffer-create
|
||||
(concat " *p4-lowlevel-" buffer "*"))))
|
||||
text)
|
||||
(save-excursion
|
||||
(set-buffer output-buffer)
|
||||
(erase-buffer)
|
||||
(insert (p4-lowlevel-info-lines output-alist))
|
||||
(if (setq text (p4-lowlevel-text output-alist))
|
||||
(insert text))
|
||||
output-buffer)))
|
||||
|
||||
(defun p4-lowlevel-command-messages ()
|
||||
"Return t if p4-lowlevel-command-messages or vc-command-messages is
|
||||
bound and true."
|
||||
(if (and (boundp 'vc-command-messages) vc-command-messages)
|
||||
t
|
||||
p4-lowlevel-command-messages))
|
||||
|
||||
(defun p4-lowlevel-canonicalize-revision (rev)
|
||||
"Turn REV into a form which can be concatenated to file names in P4
|
||||
commands."
|
||||
; There is some ambiguity here, since a number can be either a
|
||||
; revision number (#rev) or a change number (@change). We assume
|
||||
; that a bare number is a revision number.
|
||||
(if rev
|
||||
(if (string= rev "")
|
||||
nil
|
||||
(if (string-match "\\`[0-9]+\\'" rev)
|
||||
(concat "#" rev)
|
||||
(if (not (string-match "^[#@]" rev))
|
||||
(concat "@" rev)
|
||||
rev)))))
|
||||
|
||||
; Here's what we need to support from the "p4 add" command, at least
|
||||
; for the time being:
|
||||
;
|
||||
; Do NOT need to support "-c".
|
||||
; Do NOT need to support "-t".
|
||||
; Do NOT need to support the specification of multiple files.
|
||||
|
||||
(defun p4-lowlevel-add (file)
|
||||
"Tell Perforce to add FILE to the repository.
|
||||
Returns nil or raises an error on failure."
|
||||
; Note that because "p4 -s add" has bugs, at least as of p4 99.2,
|
||||
; this won't necessarily detect when the add fails, e.g., because of
|
||||
; an attempt to add a file which already exists in the repository.
|
||||
(p4-lowlevel-command-or-error (list "add" file)))
|
||||
|
||||
; Here's what we need to support from the "p4 change" command, at
|
||||
; least for the time being:
|
||||
;
|
||||
; Do NOT need to support "-f".
|
||||
; Do NOT need to support "-d".
|
||||
; DO need to support "-o".
|
||||
; DO need to support "-i".
|
||||
; DO need to support specified changelist #'s.
|
||||
|
||||
(defun p4-lowlevel-change (&optional buffer op)
|
||||
"Creates or edits a P4 changelist from/to BUFFER.
|
||||
If optional OP is a number, then the corresponding changelist is
|
||||
retrieved into BUFFER, or into a new buffer if BUFFER is nil. If OP
|
||||
is non-nil and not a number, then then BUFFER should contain an
|
||||
existing changelist which is saved to the database; the number of the
|
||||
new or updated changelist is returned. If OP is nil then a new
|
||||
changelist is retrieved into BUFFER (or a new buffer). The output
|
||||
buffer is returned."
|
||||
(let* ((input-buffer (if (and op (not (numberp op))) buffer nil))
|
||||
(flag-arg (if (or (not op) (numberp op)) "-o" "-i"))
|
||||
(number-arg (if (numberp op) (list (number-to-string op))))
|
||||
(args (append (list "change" flag-arg) number-arg))
|
||||
alist info)
|
||||
(setq alist (p4-lowlevel-command-or-error args input-buffer nil))
|
||||
(setq info (p4-lowlevel-info-lines alist))
|
||||
(if (and op (not (numberp op)))
|
||||
(if (string-match "\\([0-9]+\\)" info)
|
||||
(string-to-number (match-string 1 info))
|
||||
(error "P4 error: could not parse info \"%s\"" info))
|
||||
(if (not buffer)
|
||||
(setq buffer (p4-lowlevel-get-buffer-create
|
||||
" *p4-lowlevel-change*")))
|
||||
(save-excursion
|
||||
(set-buffer buffer)
|
||||
(erase-buffer)
|
||||
(insert (p4-lowlevel-info-lines alist))
|
||||
buffer))))
|
||||
|
||||
(defun p4-lowlevel-changes (file-pattern &optional output-format rev1 rev2 i-flag l-flag m-val s-val)
|
||||
"Call `p4 changes' on FILE-PATTERN. Optional OUTPUT-FORMAT is as
|
||||
described in `p4-lowlevel-command-or-error'. Optionally, limit output
|
||||
to the revisions between REV1 and REV2. If I-FLAG is non-nil, pass
|
||||
`-i'; if L-FLAG is non-nil, pass `-l'; if M-VAL is non-nil, pass that
|
||||
value with `-m'; if S-VAL is non-nil, pass that value with `-s'."
|
||||
(setq rev1 (p4-lowlevel-canonicalize-revision rev1)
|
||||
rev2 (p4-lowlevel-canonicalize-revision rev2))
|
||||
(let ((full-file
|
||||
(if (or rev1 rev2)
|
||||
(format "%s%s,%s" file-pattern (or rev1 "") (or rev2 ""))
|
||||
file-pattern))
|
||||
(i-list (if i-flag (list "-i")))
|
||||
(l-list (if l-flag (list "-l")))
|
||||
(m-list (if m-val (list "-m" (if (numberp m-val)
|
||||
(number-to-string m-val)
|
||||
mval))))
|
||||
(s-list (if s-val (list "-s" s-val))))
|
||||
(p4-lowlevel-command-or-error (append
|
||||
(list "changes")
|
||||
i-list l-list m-list s-list
|
||||
(list full-file))
|
||||
nil output-format)))
|
||||
|
||||
; Here's what we need to support from the "p4 diff" command, at
|
||||
; least for the time being:
|
||||
;
|
||||
; DO need to support "-d<flag>".
|
||||
; DO need to support "-f" (in fact, need to specify it all the time).
|
||||
; Do NOT need to support "-s<flag>".
|
||||
; DO need to support "-t" (in fact, need to specify it all the time).
|
||||
; DO need to support diffing a single file.
|
||||
; Do NOT need to support diffing multiple files.
|
||||
|
||||
(defun p4-lowlevel-diff (file &optional rev buffer)
|
||||
"Run `p4 diff' on FILE at revision REV and return a buffer
|
||||
containing the results. REV is in the syntax described by `p4 help
|
||||
revisions'. If REV is nil, compare the client's sync'd revision to
|
||||
the file on disk. Uses `p4-lowlevel-diff-switches' to determine flags
|
||||
to pass to `p4 diff'. If optional BUFFER is non-nil, put output in
|
||||
that buffer."
|
||||
(setq rev (p4-lowlevel-canonicalize-revision rev))
|
||||
(let* ((file-spec (if rev (concat file rev) file))
|
||||
(diff-args (append (list "diff") p4-lowlevel-diff-switches
|
||||
(list "-f" "-t" file-spec)))
|
||||
(buffer (p4-lowlevel-command-into-buffer diff-args
|
||||
(or buffer "diff"))))
|
||||
buffer))
|
||||
|
||||
(defun p4-lowlevel-diff-s (file flag)
|
||||
"Run `p4 diff -s' on FILE, using FLAG as the argument to `-s', and
|
||||
return a list of the matching files."
|
||||
(p4-lowlevel-items-matching-tag
|
||||
"^info"
|
||||
(p4-lowlevel-command-or-error
|
||||
(list
|
||||
"diff"
|
||||
(format "-s%s" flag)
|
||||
file))))
|
||||
|
||||
; Here's what we need to support from the "p4 diff2" command, at least
|
||||
; for the time being:
|
||||
;
|
||||
; DO need to support "-d<flag>".
|
||||
; Do NOT need to support "-q".
|
||||
; DO need to support "-t" (in fact, need to specify it all the time).
|
||||
; Do NOT need to support "-b".
|
||||
|
||||
(defun p4-lowlevel-diff2 (file1 file2 &optional rev1 rev2 buffer)
|
||||
"Run `p4 diff2' on FILE and FILE2 and return a buffer containing the
|
||||
results. If optional REV1 and/or REV2 are non-nil, they specify the
|
||||
revisions to diff in the syntax described by `p4 help revisions'. If
|
||||
optional BUFFER is non-nil, output goes in that buffer. Uses
|
||||
`p4-lowlevel-diff-switches' to determine flags to pass to `p4 diff2'."
|
||||
(setq rev1 (p4-lowlevel-canonicalize-revision rev1)
|
||||
rev2 (p4-lowlevel-canonicalize-revision rev2))
|
||||
(let* ((file1-spec (if rev1 (concat file1 rev1) file1))
|
||||
(file2-spec (if rev2 (concat file2 rev2) file2))
|
||||
(diff-args (append (list "diff2") p4-lowlevel-diff-switches
|
||||
(list "-t" file1-spec file2-spec)))
|
||||
(buffer (p4-lowlevel-command-into-buffer diff-args
|
||||
(or buffer "diff"))))
|
||||
buffer))
|
||||
|
||||
; Here's what we need to support from the "p4 edit" command, at least
|
||||
; for the time being:
|
||||
;
|
||||
; Do NOT need to support "-c".
|
||||
; Do NOT need to support "-t".
|
||||
; Do NOT need to support the specification of multiple files.
|
||||
|
||||
(defun p4-lowlevel-edit (file)
|
||||
"Tell Perforce we want to edit FILE.
|
||||
Returns non-nil on success or nil on failure (or raises an error)."
|
||||
(p4-lowlevel-command-or-error (list "edit" file)))
|
||||
|
||||
; Here's what we need to support from the "p4 filelog" command, at
|
||||
; least for the time being:
|
||||
;
|
||||
; DO need to support "-i".
|
||||
; DO need to support "-l".
|
||||
; Do NOT need to support "-m".
|
||||
; Do NOT need to support the specification of multiple files.
|
||||
|
||||
(defun p4-lowlevel-filelog (file &optional buffer long follow-branches)
|
||||
"Fetch the p4 log of FILE and return a buffer containing it.
|
||||
If optional BUFFER is non-nil, put output in that buffer. If optional
|
||||
LONG is non-nil, return long output (i.e., pass the `-l' flag). If
|
||||
optional FOLLOW-BRANCHES is non-nil, include pre-branch log entries in
|
||||
output (i.e., pass the `-i' flag)."
|
||||
(let* ((long-flag (if long (list "-l") nil))
|
||||
(branch-flag (if follow-branches (list "-i") nil))
|
||||
(args (append (list "filelog") long-flag branch-flag (list file))))
|
||||
(p4-lowlevel-command-into-buffer args (or buffer "log"))))
|
||||
|
||||
(defun p4-lowlevel-opened (file)
|
||||
"Fetch the string returned by running `p4 opened' on FILE."
|
||||
(p4-lowlevel-command-or-error (list "opened" file) nil 'string))
|
||||
|
||||
; Here's what we need to support from the "p4 fstat" command, at least
|
||||
; for the time being:
|
||||
;
|
||||
; Do NOT need to support any command-line switches.
|
||||
; Do NOT need to support the specification of multiple files.
|
||||
|
||||
(defun p4-lowlevel-fstat (file &optional rev noerror)
|
||||
"Fetch p4 information about FILE (optionally, at REV).
|
||||
REV should be in the syntax described by `p4 help revisions'. Returns
|
||||
a list of field-name/value elements on success, or raises an error on
|
||||
failure. If optional third argument NOERROR is true, then returns nil
|
||||
rather than raising an error on failure. If FILE matches multiple
|
||||
files, then returns a list of lists of field-name/value elements."
|
||||
(setq rev (p4-lowlevel-canonicalize-revision rev))
|
||||
(let* ((file-spec (if rev (concat file rev) file))
|
||||
(args (list "fstat" file-spec))
|
||||
(alist (p4-lowlevel-re-assoc
|
||||
"^info" (p4-lowlevel-command-or-error args nil nil noerror)))
|
||||
element line field value values lists)
|
||||
(while alist
|
||||
(setq element (car alist)
|
||||
alist (cdr alist)
|
||||
line (cdr element))
|
||||
(if (not (string-match " " line))
|
||||
t
|
||||
(setq field (substring line 0 (match-beginning 0))
|
||||
value (substring line (match-end 0)))
|
||||
(if (string= field "depotFile") ; we assume depotFile is
|
||||
; always first
|
||||
(if (not values)
|
||||
t
|
||||
(setq lists (cons (nreverse values) lists))
|
||||
(setq values nil)))
|
||||
(setq values (cons (cons field value) values))))
|
||||
(if values
|
||||
(setq lists (cons (nreverse values) lists)))
|
||||
(if (= (length lists) 1)
|
||||
(car lists)
|
||||
lists)))
|
||||
|
||||
(defun p4-lowlevel-info ()
|
||||
"Return an alist representing the output of `p4 info'."
|
||||
(let* ((base-alist (p4-lowlevel-command-or-error "info"))
|
||||
(info-elements (p4-lowlevel-re-assoc "^info" base-alist))
|
||||
line tag value info-alist element)
|
||||
(while info-elements
|
||||
(setq element (car info-elements)
|
||||
info-elements (cdr info-elements)
|
||||
line (cdr element))
|
||||
(if (string-match ": " line)
|
||||
(setq tag (substring line 0 (match-beginning 0))
|
||||
value (substring line (match-end 0))
|
||||
info-alist (cons (cons tag value) info-alist))))
|
||||
(nreverse info-alist)))
|
||||
|
||||
(defun p4-lowlevel-print (file &optional rev output-format quiet)
|
||||
"Retrieve the contents of FILE using `p4 print'.
|
||||
If optional REV is non-nil, retrieve that revision, which should be in
|
||||
the syntax described by `p4 help revisions'. Optional OUTPUT-FORMAT
|
||||
is interpreted as described for `p4-lowlevel-command-or-error'. If optional
|
||||
QUIET is non-nil, then the `-q' flag is passed to `p4 print'."
|
||||
(setq rev (p4-lowlevel-canonicalize-revision rev))
|
||||
(let* ((fullfile (if rev (concat file rev) file))
|
||||
(quiet-args (if quiet (list "-q")))
|
||||
(args (append (list "print") quiet-args (list fullfile))))
|
||||
(p4-lowlevel-command-or-error args nil output-format)))
|
||||
|
||||
; Here's what we need to support from the "p4 reopen" command, at
|
||||
; least for the time being:
|
||||
;
|
||||
; DO need to support "-c changelist#", so that we can reopen a file in
|
||||
; the default changelist before submitting it.
|
||||
; Do NOT need to support "-t".
|
||||
; Do NOT need to support the specification of multiple files.
|
||||
|
||||
(defun p4-lowlevel-reopen (file &optional changelist)
|
||||
"Call `p4 reopen' on FILE.
|
||||
Optional CHANGELIST specifies the changelist to which to move it."
|
||||
(p4-lowlevel-command-or-error (append (list "reopen")
|
||||
(if changelist (list "-c" changelist) nil)
|
||||
(list file))))
|
||||
|
||||
; Here's what we need to support from the "p4 resolve" command, at
|
||||
; least for the time being:
|
||||
;
|
||||
; DO need to support "-af" (in fact, need to specify it all the time).
|
||||
; Do NOT need to support "-am", "-as", "-at", "-ay".
|
||||
; Do NOT need to support "-f".
|
||||
; Do NOT need to support "-n".
|
||||
; DO need to support "-t" (in fact, need to specify it all the time).
|
||||
; Do NOT need to support "-v".
|
||||
; Do NOT need to support the specification of multiple files.
|
||||
|
||||
(defun p4-lowlevel-resolve (file)
|
||||
"Call `p4 resolve' on FILE.
|
||||
Specifies the `-af' and `-t' options to ensure a non-interactive
|
||||
resolve. Raises an error if the command fails."
|
||||
(p4-lowlevel-command-or-error (list "resolve" "-af" "-t" file)))
|
||||
|
||||
; Here's what we need to support from the "p4 revert" command, at
|
||||
; least for the time being:
|
||||
;
|
||||
; Do NOT need to support "-a".
|
||||
; Do NOT need to support "-c".
|
||||
; Do NOT need to support the specification of multiple files.
|
||||
|
||||
(defun p4-lowlevel-revert (file)
|
||||
"Tell Perforce to unedit FILE."
|
||||
(p4-lowlevel-command-or-error (list "revert" file)))
|
||||
|
||||
; Here's what we need to support from the "p4 submit" command, at
|
||||
; least for the time being:
|
||||
;
|
||||
; Only need to support non-interactive use; therefore, only need to
|
||||
; support "p4 submit -i".
|
||||
|
||||
(defun p4-lowlevel-submit (change-spec)
|
||||
"Calls `p4 submit' on CHANGE-SPEC, which should be a string or buffer."
|
||||
(let (buffer)
|
||||
(if (bufferp change-spec)
|
||||
(setq buffer change-spec)
|
||||
(setq buffer (p4-lowlevel-get-buffer-create
|
||||
" *p4-lowlevel-submit-input*"))
|
||||
(save-excursion
|
||||
(set-buffer buffer)
|
||||
(erase-buffer)
|
||||
(insert change-spec)))
|
||||
(p4-lowlevel-command-or-error (list "submit" "-i") buffer)))
|
||||
|
||||
; Here's what we need to support from the "p4 sync" command, at least
|
||||
; for the time being:
|
||||
;
|
||||
; DO need to support "-f".
|
||||
; Do NOT need to support "-n".
|
||||
; DO need to support the specification of a file revision.
|
||||
; Do NOT need to support the specification of multiple files.
|
||||
|
||||
(defun p4-lowlevel-sync (file &optional rev force)
|
||||
"Call `p4 sync' for FILE.
|
||||
If optional REV is specified, use that revision specifier. If
|
||||
optional FORCE is non-nil, pass the `-f' flag."
|
||||
(setq rev (p4-lowlevel-canonicalize-revision rev))
|
||||
(let* ((fullfile (if rev (concat file rev) file))
|
||||
(force-args (if force (list "-f")))
|
||||
(args (append (list "sync") force-args (list fullfile))))
|
||||
(p4-lowlevel-command-or-error args)))
|
||||
|
||||
(defun p4-lowlevel-integrate (from-file to-file &optional rev1 rev2 force)
|
||||
"Call `p4 integrate' from FROM-FILE to TO-FILE, with optional revision
|
||||
range specified by REV1 and REV2, forcing the integration (i.e.,
|
||||
specifying `-f' to `p4 integrate' if FORCE is non-nil."
|
||||
(setq rev1 (p4-lowlevel-canonicalize-revision rev1)
|
||||
rev2 (p4-lowlevel-canonicalize-revision rev2))
|
||||
(let ((force-list (if force (list "-f")))
|
||||
(from-full (if (or rev1 rev2)
|
||||
(format "%s%s,%s" from-file (or rev1 "") (or rev2 ""))
|
||||
from-file)))
|
||||
(p4-lowlevel-command-or-error (append (list "integrate")
|
||||
(if force (list "-f"))
|
||||
(list from-full to-file)))))
|
||||
|
||||
(defun p4-lowlevel-client-version (&optional noerror)
|
||||
"Returns the Perforce client version string from `p4 -V'.
|
||||
Returns the third field of the last line of output from `p4 -V', or
|
||||
signals an error if the invocation failed. if optional NOERROR is
|
||||
non-nil, returns nil instead of signalling an error."
|
||||
(let ((version-string (p4-lowlevel-command-or-error "-V" nil 'string
|
||||
noerror)))
|
||||
(if (string-match "\n[^/\n]+/[^/\n]+/\\([^\n/]+\\)/.*\n?\\'"
|
||||
version-string)
|
||||
(setq version-string (match-string 1 version-string)))
|
||||
version-string))
|
||||
|
||||
(defun p4-lowlevel-get-buffer-create (name)
|
||||
"Like get-buffer-create, but always changes default-directory of the
|
||||
returned buffer to the current default-directory, even if the buffer
|
||||
already exists."
|
||||
(let ((buf (get-buffer-create name))
|
||||
(caller-default-directory default-directory))
|
||||
(save-excursion
|
||||
(set-buffer buf)
|
||||
(setq default-directory caller-default-directory))
|
||||
buf))
|
||||
|
||||
(provide 'p4-lowlevel)
|
||||
745
vc-p4.el
Normal file
745
vc-p4.el
Normal file
|
|
@ -0,0 +1,745 @@
|
|||
;;; vc-p4.el --- Integrate Perforce support into VC mode in Emacs 21
|
||||
|
||||
;; Copyright (C) 2002 Curl Corporation.
|
||||
|
||||
;; Author: Jonathan Kamens <jik@kamens.brookline.ma.us>
|
||||
;; Maintainer: Jonathan Kamens <jik@kamens.brookline.ma.us>
|
||||
|
||||
;; $Id$
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 2, or (at your option)
|
||||
;; any later version.
|
||||
;;
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program; if not, you can either send email to this
|
||||
;; program's maintainer or write to: The Free Software Foundation,
|
||||
;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file adds support for Perforce to VC mode in Emacs 21 and any
|
||||
;; other Emacs variant which uses the VC mode included in Emacs 21.
|
||||
;;
|
||||
;; To use this file, you also need p4-lowlevel.el somewhere in your
|
||||
;; load path (or load it explicitly with "load" if it's not in your
|
||||
;; load path).
|
||||
;;
|
||||
;; The easiest way to use this functionality is to put this file
|
||||
;; somewhere in your load-path and put this in one of your init files:
|
||||
;;
|
||||
;; (require 'vc-p4)
|
||||
;;
|
||||
;; Alternatively, as long as this file is in your load path, you can
|
||||
;; customize the variable vc-handled-backends and add "P4" to it; this
|
||||
;; will cause VC to load this file automatically when it is needed.
|
||||
;;
|
||||
;; You can't use this support and the full functionality of Rajesh
|
||||
;; Vaidheeswarran's "p4.el" at the same time. You can, however, use
|
||||
;; most of p4.el's functionality by setting the customization variable
|
||||
;; "p4-do-find-file" to nil. This will prevent p4.el from attempting
|
||||
;; to "take ownership" of a Perforce file when you load it, but it
|
||||
;; will allow you to use all of the p4.el commands that don't apply to
|
||||
;; the current buffer.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile
|
||||
(require 'vc)
|
||||
(require 'p4-lowlevel))
|
||||
|
||||
(if (not (memq 'P4 vc-handled-backends))
|
||||
(setq vc-handled-backends (cons 'P4 vc-handled-backends)))
|
||||
; This is useful during development to ensure that we can simply
|
||||
; reeval this buffer to get any new functions that have been added.
|
||||
(put 'P4 'vc-functions nil)
|
||||
|
||||
; We need to fix some functions that are broken in vc.el.
|
||||
|
||||
(defun vc-print-log ()
|
||||
"List the change log of the current buffer in a window."
|
||||
(interactive)
|
||||
(vc-ensure-vc-buffer)
|
||||
(let* ((file buffer-file-name)
|
||||
(use-log-view (memq (vc-backend file) '(CVS RCS SCCS))))
|
||||
(vc-call print-log file)
|
||||
(set-buffer "*vc*")
|
||||
(pop-to-buffer (current-buffer))
|
||||
(if (and use-log-view (fboundp 'log-view-mode)) (log-view-mode))
|
||||
(vc-exec-after
|
||||
`(progn
|
||||
(goto-char (point-max)) (forward-line -1)
|
||||
(while (looking-at "=*\n")
|
||||
(delete-char (- (match-end 0) (match-beginning 0)))
|
||||
(forward-line -1))
|
||||
(goto-char (point-min))
|
||||
(if (looking-at "[\b\t\n\v\f\r ]+")
|
||||
(delete-char (- (match-end 0) (match-beginning 0))))
|
||||
(shrink-window-if-larger-than-buffer)
|
||||
;; move point to the log entry for the current version
|
||||
(if (and use-log-view (fboundp 'log-view-goto-rev))
|
||||
(log-view-goto-rev ',(vc-workfile-version file))
|
||||
(if (vc-find-backend-function ',(vc-backend file) 'show-log-entry)
|
||||
(vc-call-backend ',(vc-backend file)
|
||||
'show-log-entry
|
||||
',(vc-workfile-version file))))))))
|
||||
|
||||
(if (not (fboundp 'vc-default-previous-version))
|
||||
(defun vc-previous-version (rev)
|
||||
"Guess the version number immediately preceding REV."
|
||||
(if (string-match "^[0-9]+$" rev)
|
||||
(number-to-string (- (string-to-number rev) 1))
|
||||
(let ((branch (vc-branch-part rev))
|
||||
(minor-num (string-to-number (vc-minor-part rev))))
|
||||
(if (> minor-num 1)
|
||||
;; version does probably not start a branch or release
|
||||
(concat branch "." (number-to-string (1- minor-num)))
|
||||
(if (vc-trunk-p rev)
|
||||
;; we are at the beginning of the trunk --
|
||||
;; don't know anything to return here
|
||||
""
|
||||
;; we are at the beginning of a branch --
|
||||
;; return version of starting point
|
||||
(vc-branch-part branch)))))))
|
||||
|
||||
(if (not (fboundp 'vc-default-resolve-select-yours))
|
||||
(defun vc-maybe-resolve-conflicts (file status &optional name-A name-B)
|
||||
(vc-resynch-buffer file t (not (buffer-modified-p)))
|
||||
(if (zerop status) (message "Merge successful")
|
||||
(if (fboundp 'smerge-mode) (smerge-mode 1))
|
||||
(if (y-or-n-p "Conflicts detected. Resolve them now? ")
|
||||
(if (and (fboundp 'smerge-ediff)
|
||||
(not (vc-find-backend-function (vc-backend file)
|
||||
'resolve-select-yours)))
|
||||
(smerge-ediff)
|
||||
(vc-resolve-conflicts name-A name-B))
|
||||
(message "File contains conflict markers"))))
|
||||
|
||||
(defun vc-default-resolve-select-yours (backend)
|
||||
(goto-char (point-min))
|
||||
(let ((found nil))
|
||||
(while (re-search-forward (concat "^<<<<<<< "
|
||||
(regexp-quote file-name) "\n") nil t)
|
||||
(setq found t)
|
||||
(replace-match "")
|
||||
(if (not (re-search-forward "^=======\n" nil t))
|
||||
(error "Malformed conflict marker"))
|
||||
(replace-match "")
|
||||
(let ((start (point)))
|
||||
(if (not (re-search-forward "^>>>>>>> [0-9.]+\n" nil t))
|
||||
(error "Malformed conflict marker"))
|
||||
(delete-region start (point))))
|
||||
found))
|
||||
|
||||
(defun vc-default-resolve-select-theirs (backend)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward (concat "^<<<<<<< "
|
||||
(regexp-quote file-name) "\n") nil t)
|
||||
(let ((start (match-beginning 0)))
|
||||
(if (not (re-search-forward "^=======\n" nil t))
|
||||
(error "Malformed conflict marker"))
|
||||
(delete-region start (point))
|
||||
(if (not (re-search-forward "^>>>>>>> [0-9.]+\n" nil t))
|
||||
(error "Malformed conflict marker"))
|
||||
(replace-match "")))
|
||||
t)
|
||||
|
||||
(defun vc-default-resolve-select-original (backend)
|
||||
nil)
|
||||
|
||||
(defun vc-resolve-conflicts (&optional name-A name-B)
|
||||
"Invoke ediff to resolve conflicts in the current buffer.
|
||||
The conflicts must be marked with rcsmerge conflict markers."
|
||||
(interactive)
|
||||
(vc-ensure-vc-buffer)
|
||||
(let* ((found nil)
|
||||
(file-name (file-name-nondirectory buffer-file-name))
|
||||
(backend (vc-backend buffer-file-name))
|
||||
(your-buffer (generate-new-buffer
|
||||
(concat "*" file-name
|
||||
" " (or name-A "WORKFILE") "*")))
|
||||
(other-buffer (generate-new-buffer
|
||||
(concat "*" file-name
|
||||
" " (or name-B "CHECKED-IN") "*")))
|
||||
(ancestor-buffer (generate-new-buffer
|
||||
(concat "*" file-name
|
||||
" " (or name-B "ORIGINAL") "*")))
|
||||
(result-buffer (current-buffer)))
|
||||
(save-excursion
|
||||
(set-buffer your-buffer)
|
||||
(erase-buffer)
|
||||
(insert-buffer result-buffer)
|
||||
(if (not (vc-call-backend backend 'resolve-select-yours))
|
||||
(progn
|
||||
(kill-buffer your-buffer)
|
||||
(kill-buffer other-buffer)
|
||||
(kill-buffer ancestor-buffer)
|
||||
(error "No conflict markers found")))
|
||||
|
||||
(set-buffer other-buffer)
|
||||
(erase-buffer)
|
||||
(insert-buffer result-buffer)
|
||||
(vc-call-backend backend 'resolve-select-theirs)
|
||||
|
||||
(set-buffer ancestor-buffer)
|
||||
(erase-buffer)
|
||||
(insert-buffer result-buffer)
|
||||
(goto-char (point-min))
|
||||
(if (not (vc-call-backend backend 'resolve-select-original))
|
||||
(progn
|
||||
(kill-buffer ancestor-buffer)
|
||||
(setq ancestor-buffer nil)))
|
||||
|
||||
(let ((config (current-window-configuration)))
|
||||
|
||||
;; Fire up ediff.
|
||||
|
||||
(set-buffer
|
||||
(if ancestor-buffer
|
||||
(ediff-merge-buffers-with-ancestor your-buffer other-buffer
|
||||
ancestor-buffer)
|
||||
(let ((ediff-default-variant 'default-B))
|
||||
(ediff-merge-buffers your-buffer other-buffer))))
|
||||
|
||||
;; Ediff is now set up, and we are in the control buffer.
|
||||
;; Do a few further adjustments and take precautions for exit.
|
||||
|
||||
(make-local-variable 'vc-ediff-windows)
|
||||
(setq vc-ediff-windows config)
|
||||
(make-local-variable 'vc-ediff-result)
|
||||
(setq vc-ediff-result result-buffer)
|
||||
(make-local-variable 'ediff-quit-hook)
|
||||
(setq ediff-quit-hook
|
||||
(lambda ()
|
||||
(let ((buffer-A ediff-buffer-A)
|
||||
(buffer-B ediff-buffer-B)
|
||||
(buffer-C ediff-buffer-C)
|
||||
(result vc-ediff-result)
|
||||
(windows vc-ediff-windows))
|
||||
(ediff-cleanup-mess)
|
||||
(set-buffer result)
|
||||
(erase-buffer)
|
||||
(insert-buffer buffer-C)
|
||||
(kill-buffer buffer-A)
|
||||
(kill-buffer buffer-B)
|
||||
(kill-buffer buffer-C)
|
||||
(set-window-configuration windows)
|
||||
(message "Conflict resolution finished; you may save the buffer"))))
|
||||
(message "Please resolve conflicts now; exit ediff when done")
|
||||
nil)))))
|
||||
|
||||
(defvar vc-p4-change-times nil
|
||||
"Alist of change numbers (represented as strings) and their age with
|
||||
respect to the current time. Set and used when annotating a Perforce
|
||||
file in VC.")
|
||||
|
||||
(defcustom vc-p4-require-p4config nil
|
||||
"*If non-nil and the `P4CONFIG' environment variable is set, then
|
||||
only perform p4 operations on a file when a P4CONFIG file can be found
|
||||
in one of its parent directories. This is useful if P4 operations are
|
||||
expensive to start, e.g., if you are connect to the network over a
|
||||
slow dialup connection and/or using a SSH tunnel for P4 access. To
|
||||
avoid delays when opening non-P4 files, simply set P4CONFIG as
|
||||
described in the Perforce documentation, create an empty P4CONFIG file
|
||||
at the root of your client workspace, and set `vc-p4-require-p4config'
|
||||
to t."
|
||||
:type 'boolean
|
||||
:group 'vc)
|
||||
|
||||
(defcustom vc-p4-annotate-command "p4pr"
|
||||
"*Specifies the name of a command to call to annotate Perforce
|
||||
files. I recommend //guest/jonathan_kamens/p4pr.perl in the Perforce
|
||||
repository public.perforce.com:1666."
|
||||
:type 'string
|
||||
:group 'vc)
|
||||
|
||||
(defun vc-p4-registered (file)
|
||||
"Return non-nil is FILE is handled by Perforce."
|
||||
(if (and vc-p4-require-p4config
|
||||
(getenv "P4CONFIG")
|
||||
(not (vc-p4-find-p4config (file-name-directory file))))
|
||||
nil
|
||||
(let ((fstat (p4-lowlevel-fstat file nil t)))
|
||||
(if (not fstat)
|
||||
nil
|
||||
; This sets a bunch of VC properties
|
||||
(vc-p4-state file fstat)
|
||||
t))))
|
||||
|
||||
(defun vc-p4-state (file &optional fstat-list force)
|
||||
"Returns the current version control state of FILE in Perforce. If
|
||||
optional FSTAT-LIST is non-nil, use that list of attributes from
|
||||
p4-lowlevel-fstat instead of calling it. If optional FORCE is
|
||||
non-nil, refetch all properties even if properties were previously
|
||||
fetched."
|
||||
(if (and (not force) (vc-file-getprop file 'vc-p4-did-fstat))
|
||||
(vc-file-getprop file 'vc-state)
|
||||
(let* (
|
||||
(alist (or fstat-list (p4-lowlevel-fstat file nil)))
|
||||
(headRev (cdr (assoc "headRev" alist)))
|
||||
(haveRev (cdr (assoc "haveRev" alist)))
|
||||
(depotFile (cdr (assoc "depotFile" alist)))
|
||||
(action (cdr (assoc "action" alist)))
|
||||
(state (if action
|
||||
(let ((opened (p4-lowlevel-opened file)))
|
||||
(if (string-match " by \\([^@]+\\)@" opened)
|
||||
(match-string 1 opened)
|
||||
(if (equal headRev haveRev)
|
||||
'edited
|
||||
'needs-merge)))
|
||||
(if (p4-lowlevel-diff-s file "e")
|
||||
'unlocked-changes
|
||||
(if (equal headRev haveRev)
|
||||
'up-to-date
|
||||
'needs-patch))))
|
||||
)
|
||||
(vc-file-setprop file 'vc-p4-did-fstat t)
|
||||
(vc-file-setprop file 'vc-p4-depot-file depotFile)
|
||||
(vc-file-setprop file 'vc-p4-action action)
|
||||
(vc-file-setprop file 'vc-backend 'P4)
|
||||
(vc-file-setprop file 'vc-checkout-model 'announce)
|
||||
(vc-file-setprop file 'vc-latest-version headRev)
|
||||
(vc-file-setprop file 'vc-name file)
|
||||
(vc-file-setprop file 'vc-state state)
|
||||
(vc-file-setprop file 'vc-workfile-version haveRev)
|
||||
state)))
|
||||
|
||||
; Here's something that would work faster, but I'm not going to
|
||||
; actually try to use this unless I find that it's really too slow to
|
||||
; just do all the work all the time.
|
||||
;(defun vc-p4-state-heuristic (file)
|
||||
; "Estimates the current version control state of FILE in Perforce."
|
||||
; (if (and (file-exists-p file)
|
||||
; (file-writable-p file))
|
||||
; 'edited
|
||||
; 'up-to-date))
|
||||
|
||||
(defun vc-p4-state-heuristic (file)
|
||||
(vc-p4-state file))
|
||||
|
||||
(defun vc-p4-dir-state (dir)
|
||||
"Determines the current version control state of the files in DIR in
|
||||
Perforce and sets the appropriate VC properties."
|
||||
(let ((lists (p4-lowlevel-fstat (format "%s/*" dir) nil t))
|
||||
this-list this-file this-action)
|
||||
(if (stringp (caar lists))
|
||||
(setq lists (list lists)))
|
||||
(while lists
|
||||
(setq this-list (car lists)
|
||||
lists (cdr lists)
|
||||
this-file (cdr (assoc "clientFile" this-list))
|
||||
this-action (cdr (or (assoc "action" this-list)
|
||||
(assoc "headAction" this-list))))
|
||||
(if (and this-file
|
||||
(not (string= this-action "delete")))
|
||||
(vc-p4-state this-file this-list)))))
|
||||
|
||||
(defun vc-p4-workfile-version (file)
|
||||
"Returns the Perforce version of FILE."
|
||||
(vc-p4-state file)
|
||||
(vc-file-getprop file 'vc-workfile-version))
|
||||
|
||||
(defun vc-p4-latest-on-branch-p (file)
|
||||
"Returns non-nil if the Perforce version of FILE is the head
|
||||
revision."
|
||||
(vc-p4-state file)
|
||||
(string= (vc-file-getprop file 'vc-latest-version)
|
||||
(vc-file-getprop file 'vc-workfile-version)))
|
||||
|
||||
(defun vc-p4-checkout-model (file)
|
||||
"Returns the checkout model for Perforce (`announce')."
|
||||
'announce)
|
||||
|
||||
(defun vc-p4-workfile-unchanged-p (file)
|
||||
"Returns non-nil if FILE is unchanged from the version in Perforce."
|
||||
(let ((state (vc-p4-state file)))
|
||||
(and (not (equal (vc-file-getprop file 'vc-p4-action) "add"))
|
||||
(or (equal state 'up-to-date)
|
||||
(equal state 'needs-patch)
|
||||
(p4-lowlevel-diff-s file "r")))))
|
||||
|
||||
(defun vc-p4-mode-line-string (file)
|
||||
"Return string for placement into the modeline for FILE.
|
||||
Compared to the default implementation, this function handles the
|
||||
special case of a Perforce file that is added but not yet committed."
|
||||
(let ((state (vc-state file))
|
||||
(rev (vc-workfile-version file)))
|
||||
(if (or (not rev) (string= rev "0"))
|
||||
(setq rev "@@"))
|
||||
(cond ((or (eq state 'up-to-date)
|
||||
(eq state 'needs-patch))
|
||||
(concat "P4-" rev))
|
||||
((stringp state)
|
||||
(concat "P4:" state ":" rev))
|
||||
(t
|
||||
;; Not just for the 'edited state, but also a fallback
|
||||
;; for all other states. Think about different symbols
|
||||
;; for 'needs-patch and 'needs-merge.
|
||||
(concat "P4:" rev)))))
|
||||
|
||||
(defun vc-p4-register (file &optional rev comment)
|
||||
(if rev
|
||||
(error "Can't specify revision when registering Perforce file."))
|
||||
(if comment
|
||||
(error "Can't specify comment when registering Perforce file."))
|
||||
(p4-lowlevel-add file))
|
||||
|
||||
(defun vc-p4-responsible-p (file)
|
||||
"Returns true if FILE refers to a file or directory that is
|
||||
administered by Perforce."
|
||||
(if (and vc-p4-require-p4config
|
||||
(getenv "P4CONFIG")
|
||||
(not (vc-p4-find-p4config file)))
|
||||
nil
|
||||
(or (p4-lowlevel-fstat file nil t)
|
||||
(vc-p4-is-in-client (if (file-directory-p file)
|
||||
(file-name-as-directory file)
|
||||
file)))))
|
||||
|
||||
(defun vc-p4-checkin (file rev comment)
|
||||
"Check FILE into Perforce. Error if REV is non-nil. Check in with
|
||||
comment COMMENT."
|
||||
(if rev
|
||||
(error "Can't specify revision for Perforce checkin."))
|
||||
(let* ((default-directory (file-name-directory file))
|
||||
(change-buffer (p4-lowlevel-change))
|
||||
(indent-tabs-mode 1)
|
||||
insertion-start change-number)
|
||||
(if (vc-p4-has-unresolved-conflicts-p file)
|
||||
(error "File %s has unresolved conflicts" file))
|
||||
(save-excursion
|
||||
(set-buffer change-buffer)
|
||||
(goto-char (point-min))
|
||||
(re-search-forward "^Description:\\s-*\n")
|
||||
(kill-line 1)
|
||||
(setq insertion-start (point))
|
||||
(insert comment "\n")
|
||||
(indent-rigidly insertion-start (point) 8)
|
||||
(re-search-forward "^Files:\\s-*\n")
|
||||
(delete-region (point) (point-max))
|
||||
(insert "\t" (vc-file-getprop file 'vc-p4-depot-file) "\n")
|
||||
(setq change-number (p4-lowlevel-change (current-buffer) t))
|
||||
(p4-lowlevel-change (current-buffer) change-number)
|
||||
(p4-lowlevel-submit (current-buffer))
|
||||
; Update its properties
|
||||
(vc-p4-state file nil t)
|
||||
(vc-mode-line file))))
|
||||
|
||||
(defun vc-p4-checkout (file &optional editable rev destfile)
|
||||
(if (and editable destfile (not (string= file destfile)))
|
||||
(error "Can't lock a Perforce file in an alternate location."))
|
||||
(if (string= file destfile)
|
||||
(setq destfile nil))
|
||||
(let ((default-directory (file-name-directory file))
|
||||
buffer)
|
||||
; Make sure we've got all the current state of the file
|
||||
(vc-p4-state file)
|
||||
(cond
|
||||
((not rev)
|
||||
(setq rev (vc-file-getprop file 'vc-workfile-version)))
|
||||
((string= rev "")
|
||||
(setq rev (vc-file-getprop file 'vc-latest-version))))
|
||||
(if destfile
|
||||
(progn (setq buffer (p4-lowlevel-print file rev 'buffer t))
|
||||
(set-buffer buffer)
|
||||
(write-file destfile))
|
||||
(if (not (string= rev (vc-file-getprop file 'vc-workfile-version)))
|
||||
(p4-lowlevel-sync file rev))
|
||||
(if editable
|
||||
(p4-lowlevel-edit file))))
|
||||
(vc-p4-state file nil t))
|
||||
|
||||
(defun vc-p4-revert (file contents-done)
|
||||
"Revert FILE in Perforce. Ignores CONTENTS-DONE."
|
||||
(p4-lowlevel-revert file)
|
||||
(vc-p4-state file nil t))
|
||||
|
||||
(defun vc-p4-merge (file rev1 rev2)
|
||||
"Merge changes into Perforce FILE from REV1 to REV2."
|
||||
(p4-lowlevel-integrate file file rev1 rev2 t)
|
||||
(p4-lowlevel-resolve file)
|
||||
(vc-resynch-buffer file t t)
|
||||
(vc-p4-state file nil t)
|
||||
(if (vc-p4-has-unresolved-conflicts-p file)
|
||||
1
|
||||
0))
|
||||
|
||||
(defun vc-p4-merge-news (file)
|
||||
"Merge new changes from Perforce into FILE."
|
||||
(p4-lowlevel-sync file)
|
||||
(p4-lowlevel-resolve file)
|
||||
(vc-resynch-buffer file t t)
|
||||
(vc-p4-state file nil t)
|
||||
(if (vc-p4-has-unresolved-conflicts-p file)
|
||||
1
|
||||
0))
|
||||
|
||||
(defun vc-p4-resolve-select-yours ()
|
||||
(vc-p4-select-conflict-text (current-buffer) 3))
|
||||
|
||||
(defun vc-p4-resolve-select-theirs ()
|
||||
(vc-p4-select-conflict-text (current-buffer) 2))
|
||||
|
||||
(defun vc-p4-resolve-select-original ()
|
||||
(vc-p4-select-conflict-text (current-buffer) 1))
|
||||
|
||||
(defun vc-p4-steal-lock (file &optional version)
|
||||
"Steal Perforce lock on FILE."
|
||||
(if (and version (not (equal version (vc-workfile-version file))))
|
||||
(error "Can't specify version when stealing Perforce lock."))
|
||||
; Must set default-directory because this is called in a mail send
|
||||
; hook and thus not with the current buffer set to the file being
|
||||
; reopened.
|
||||
(let ((default-directory (file-name-directory file)))
|
||||
(p4-lowlevel-reopen file)))
|
||||
|
||||
(defun vc-p4-print-log (file)
|
||||
"Print Perforce log for FILE into *vc* buffer."
|
||||
(let ((inhibit-read-only t))
|
||||
(set-buffer (get-buffer-create "*vc*"))
|
||||
(erase-buffer)
|
||||
(p4-lowlevel-filelog file (current-buffer) t t)))
|
||||
|
||||
(defun vc-p4-show-log-entry (version)
|
||||
"Make sure Perforce log entry for VERSION is displayed in the
|
||||
current buffer."
|
||||
(goto-char (point-min))
|
||||
(let (start end lines)
|
||||
(if (not (search-forward (format "\n#%s " version) nil t)) t
|
||||
(beginning-of-line)
|
||||
(setq start (point))
|
||||
(if (not (search-forward "\n#" nil t))
|
||||
(setq end (point-max))
|
||||
(beginning-of-line)
|
||||
(setq end (point)))
|
||||
(setq lines (count-lines start end))
|
||||
(cond
|
||||
;; if the global information and this log entry fit
|
||||
;; into the window, display from the beginning
|
||||
((< (count-lines (point-min) end) (window-height))
|
||||
(goto-char (point-min))
|
||||
(recenter 0)
|
||||
(goto-char start))
|
||||
;; if the whole entry fits into the window,
|
||||
;; display it centered
|
||||
((< (1+ lines) (window-height))
|
||||
(goto-char start)
|
||||
(recenter (1- (- (/ (window-height) 2) (/ lines 2)))))
|
||||
;; otherwise (the entry is too large for the window),
|
||||
;; display from the start
|
||||
(t
|
||||
(goto-char start)
|
||||
(recenter 0))))))
|
||||
|
||||
(defun vc-p4-wash-log (file)
|
||||
"Remove all non-comment information from the Perforce log in the
|
||||
current buffer."
|
||||
(goto-char (point-min))
|
||||
(delete-non-matching-lines "^\t"))
|
||||
|
||||
(defun vc-p4-update-changelog (&optional files)
|
||||
"Create ChangeLog entriers for FILES if it's non-nil, or for all
|
||||
files under the default directory otherwise."
|
||||
(let ((odefault default-directory)
|
||||
(changelog (find-change-log))
|
||||
default-directory start-rev end-rev)
|
||||
(find-file-other-window changelog)
|
||||
(setq default-directory odefault)
|
||||
(goto-char (point-min))
|
||||
(if (looking-at
|
||||
"^\\([0-9]\\{4\\}\\)[-/]\\([0-9]\\{2\\}\\)[-/]\\([0-9]\\{2\\}\\) ")
|
||||
(setq start-rev (format "@%s/%s/%s"
|
||||
(match-string 1)
|
||||
(match-string 2)
|
||||
(match-string 3))
|
||||
end-rev "@now"))
|
||||
(if (not files)
|
||||
(setq files "..."))
|
||||
(message "Computing change log entries...")
|
||||
(insert (p4-lowlevel-info-lines
|
||||
(p4-lowlevel-changes files nil start-rev end-rev
|
||||
nil t nil "submitted")))
|
||||
(if (= (point) (point-min)) t
|
||||
(if (not (= (point) (point-max)))
|
||||
(insert "\n"))
|
||||
(while (re-search-backward
|
||||
(concat "^Change [0-9]+ on \\([0-9]+\\)/"
|
||||
"\\([0-9]+\\)/\\([0-9]+\\) by \\(.+\\)")
|
||||
nil t nil)
|
||||
(replace-match "\n\\1-\\2-\\3 \\4" t))
|
||||
(goto-char (point-min))
|
||||
(if (looking-at "\n")
|
||||
(kill-line)))
|
||||
(message "Computing change log entries... done")))
|
||||
|
||||
(defun vc-p4-diff (file &optional rev1 rev2)
|
||||
"Do a Perforce diff into the *vc-diff* buffer."
|
||||
(let ((buffer (get-buffer-create "*vc-diff*"))
|
||||
(workfile-version (vc-file-getprop file 'vc-workfile-version))
|
||||
(inhibit-read-only t))
|
||||
(if (not rev1)
|
||||
(if (not rev2)
|
||||
(p4-lowlevel-diff file buffer)
|
||||
(p4-lowlevel-diff2 file file workfile-version rev2 buffer))
|
||||
(if rev2
|
||||
(p4-lowlevel-diff2 file file rev1 rev2 buffer)
|
||||
(p4-lowlevel-diff file rev1 buffer)))))
|
||||
|
||||
(defun vc-p4-annotate-command (file buffer &optional version)
|
||||
"Annotate FILE into BUFFER file using `vc-p4-annotate-command'.
|
||||
Annotate version VERSION if it's specified."
|
||||
(let ((full-file (if version
|
||||
(concat file
|
||||
(p4-lowlevel-canonicalize-revision version))
|
||||
file))
|
||||
(now (car (current-time)))
|
||||
log-buffer times)
|
||||
(call-process vc-p4-annotate-command
|
||||
nil
|
||||
buffer
|
||||
nil
|
||||
full-file)
|
||||
; Calculate the date of each revision, for later
|
||||
(setq log-buffer (p4-lowlevel-filelog file nil nil t))
|
||||
(set-buffer log-buffer)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward (concat "^#[0-9]+ change \\([0-9]+\\) .* on \\("
|
||||
"[0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)")
|
||||
nil t)
|
||||
(let* ((change-no (match-string 1))
|
||||
(year (string-to-number (match-string 2)))
|
||||
(month (string-to-number (match-string 3)))
|
||||
(day (string-to-number (match-string 4)))
|
||||
(then (car (encode-time 0 0 0 day month year)))
|
||||
(difference (- now then)))
|
||||
(setq times (cons (cons change-no difference)
|
||||
times))))
|
||||
(set-buffer buffer)
|
||||
(setq vc-p4-change-times times)))
|
||||
|
||||
(defun vc-p4-annotate-difference (point)
|
||||
"Returns the difference between the age of the Perforce annotation
|
||||
line at point and the current time."
|
||||
(let ((regex (concat "^[[:space:]]*[[:digit:]]+[[:space:]]+"
|
||||
"[^[:space:]]+[[:space:]]+\\([[:digit:]]+\\)"))
|
||||
match)
|
||||
(if (and (or (looking-at regex)
|
||||
(and (re-search-forward regex nil t)
|
||||
(forward-line 0)))
|
||||
(setq match (assoc (match-string 1) vc-p4-change-times)))
|
||||
(cdr match)
|
||||
nil)))
|
||||
|
||||
(defun vc-p4-previous-version (file rev)
|
||||
"Return the Perforce revision of FILE prior to REV."
|
||||
(number-to-string (- (string-to-number rev) 1)))
|
||||
|
||||
(defun vc-p4-find-p4config (&optional dirname)
|
||||
"See if there is a $P4CONFIG file in DIRNAME or any of its parents.
|
||||
If DIRNAME is not specified, uses `default-directory'."
|
||||
(let ((this-directory (or dirname default-directory))
|
||||
(p4config (getenv "P4CONFIG"))
|
||||
child)
|
||||
(if (not p4config)
|
||||
nil
|
||||
(catch 'found
|
||||
(while (not (equal this-directory child))
|
||||
(if (file-exists-p (concat this-directory p4config))
|
||||
(throw 'found (concat this-directory p4config)))
|
||||
(setq child this-directory)
|
||||
(setq this-directory (file-name-directory
|
||||
(directory-file-name this-directory))))))))
|
||||
|
||||
(defun vc-p4-is-in-client (file)
|
||||
"Return true if FILE is inside the p4 client hierarchy."
|
||||
(let* ((default-directory (file-name-directory file))
|
||||
(info (p4-lowlevel-info))
|
||||
(root-pair (assoc "Client root" info))
|
||||
(root (and root-pair (cdr root-pair)))
|
||||
(quoted-root (and root (concat "^" (regexp-quote root))))
|
||||
(cwd-pair (assoc "Current directory" info))
|
||||
(cwd (and cwd-pair (cdr cwd-pair))))
|
||||
(if (or (not quoted-root) (not (string-match quoted-root cwd)))
|
||||
nil
|
||||
(setq cwd (replace-match "" nil nil cwd))
|
||||
(if (or (string= cwd "") (string-match "^/" cwd))
|
||||
t
|
||||
nil))))
|
||||
|
||||
(defun vc-p4-has-unresolved-conflicts-p (file)
|
||||
"Search through FILE's buffer for unresolved P4 conflicts.
|
||||
If FILE is a string, then the buffer visiting that file is searched;
|
||||
no search occurs if no buffer is visiting the file. If FILE is a
|
||||
buffer, then that buffer is searched.
|
||||
|
||||
Returns nil if there are no conflicts. If there are conflicts,
|
||||
returns a list of buffer positions containing the start and end of the
|
||||
first conflict block in the file and then the start and end of each
|
||||
subblock within it."
|
||||
(let ((buffer (if (bufferp file) file (get-file-buffer file)))
|
||||
block-start block-end block1-start block1-end block2-start block2-end
|
||||
block3-start block3-end)
|
||||
(if (not buffer)
|
||||
nil
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(set-buffer buffer)
|
||||
(widen)
|
||||
(goto-char (point-min))
|
||||
(if (not (re-search-forward "^>>>>\\( .*\\|\\)\n" nil t))
|
||||
nil
|
||||
(setq block-start (match-beginning 0)
|
||||
block1-start (match-end 0))
|
||||
(if (not (re-search-forward "^<<<<\\( .*\\|\\)\n" nil t))
|
||||
nil
|
||||
; Could actually be block 3, but but we'll figure that out later.
|
||||
(setq block2-end (match-beginning 0)
|
||||
block-end (match-end 0))
|
||||
(goto-char block1-start)
|
||||
(if (not (re-search-forward "^====\\( .*\\|\\)\n" block-end t))
|
||||
nil
|
||||
(setq block1-end (match-beginning 0)
|
||||
block2-start (match-end 0))
|
||||
(if (not (re-search-forward "^====\\( .*\\|\\)\n" block-end t))
|
||||
(list block-start block-end
|
||||
block1-start block1-end
|
||||
block2-start block2-end)
|
||||
(setq block3-end block2-end
|
||||
block2-end (match-beginning 0)
|
||||
block3-start (match-end 0))
|
||||
(list block-start block-end
|
||||
block1-start block1-end
|
||||
block2-start block2-end
|
||||
block3-start block3-end))))))))))
|
||||
|
||||
(defun vc-p4-select-conflict-text (buffer which)
|
||||
"Search for P4 conflict markers in BUFFER and select the WHICH text of each.
|
||||
WHICH should be either 1, 2, or 3 to indicate the first, second or
|
||||
third subblock in each conflict block."
|
||||
(let (block-list block-start block-end sub-start sub-end sublist subcount
|
||||
replacement)
|
||||
(save-excursion
|
||||
(set-buffer buffer)
|
||||
(while (setq block-list (vc-p4-has-unresolved-conflicts-p buffer))
|
||||
(setq block-start (car block-list)
|
||||
block-end (cadr block-list)
|
||||
subcount which)
|
||||
(while (and block-list (> subcount 0))
|
||||
(setq block-list (cddr block-list)
|
||||
subcount (1- subcount)))
|
||||
(setq replacement (if block-list
|
||||
(buffer-substring (car block-list)
|
||||
(cadr block-list))
|
||||
""))
|
||||
(delete-region block-start block-end)
|
||||
(goto-char block-start)
|
||||
(insert replacement)))
|
||||
(if block-start t nil)))
|
||||
|
||||
(provide 'vc-p4)
|
||||
Loading…
Reference in a new issue