Fix whitespace

This commit is contained in:
Tom Willemse 2017-06-07 00:03:49 -07:00
parent 3cb296d970
commit e7a25a4fda
2 changed files with 455 additions and 467 deletions

View file

@ -69,9 +69,7 @@ a portion of the error string you wish to ignore."
avoid an error on systems on which the Perforce client is not installed." avoid an error on systems on which the Perforce client is not installed."
(if (and (boundp 'exec-suffixes) (fboundp 'file-executable-p)) (if (and (boundp 'exec-suffixes) (fboundp 'file-executable-p))
(locate-file p4-lowlevel-p4-program exec-path exec-suffixes 'file-executable-p) ; GNU Emacs (locate-file p4-lowlevel-p4-program exec-path exec-suffixes 'file-executable-p) ; GNU Emacs
(locate-file p4-lowlevel-p4-program exec-path '("" ".btm" ".bat" ".cmd" ".exe" ".com") 'executable) ; XEmacs (locate-file p4-lowlevel-p4-program exec-path '("" ".btm" ".bat" ".cmd" ".exe" ".com") 'executable))) ; XEmacs
)
)
(defun p4-lowlevel-command-to-buffer (args &optional input output) (defun p4-lowlevel-command-to-buffer (args &optional input output)
"Call `p4-lowlevel-p4-command' with specified list of ARGS. "Call `p4-lowlevel-p4-command' with specified list of ARGS.
@ -93,9 +91,9 @@ Returns the buffer containing the program output."
(if (stringp args) (if (stringp args)
(setq args (list args))) (setq args (list args)))
(let* (apply-args p4-args call-func string-command exit-status (let* (apply-args p4-args call-func string-command exit-status
(temp-name " *p4-lowlevel-output*") (temp-name " *p4-lowlevel-output*")
(output-buffer (or output (p4-lowlevel-get-buffer-create temp-name))) (output-buffer (or output (p4-lowlevel-get-buffer-create temp-name)))
(my-default-directory default-directory)) (my-default-directory default-directory))
(save-excursion (save-excursion
(set-buffer output-buffer) (set-buffer output-buffer)
(while (and my-default-directory (while (and my-default-directory
@ -112,7 +110,7 @@ Returns the buffer containing the program output."
(progn (set-buffer input) (progn (set-buffer input)
(setq call-func 'call-process-region) (setq call-func 'call-process-region)
(setq apply-args (list (point-min) (point-max) (setq apply-args (list (point-min) (point-max)
p4-lowlevel-p4-program nil))) p4-lowlevel-p4-program nil)))
(setq call-func 'call-process) (setq call-func 'call-process)
(setq apply-args (list p4-lowlevel-p4-program input))) (setq apply-args (list p4-lowlevel-p4-program input)))
(setq p4-args (append (list "-s") args)) (setq p4-args (append (list "-s") args))
@ -120,7 +118,7 @@ Returns the buffer containing the program output."
(progn (setq string-command (progn (setq string-command
(mapconcat (lambda (s) s) (mapconcat (lambda (s) s)
(append (list p4-lowlevel-p4-program) (append (list p4-lowlevel-p4-program)
p4-args) " ")) p4-args) " "))
(message "Running %s..." string-command))) (message "Running %s..." string-command)))
(let ((default-directory my-default-directory)) (let ((default-directory my-default-directory))
(setq exit-status (apply call-func (setq exit-status (apply call-func
@ -177,7 +175,7 @@ The alist is in the same order as the contents of the buffer."
(if (not (= last-match-end (point-max))) (if (not (= last-match-end (point-max)))
(progn (setq tag "text" (progn (setq tag "text"
value (buffer-substring last-match-end value (buffer-substring last-match-end
(- (point-max) 1)) (- (point-max) 1))
alist (cons (cons tag value) alist)))) alist (cons (cons tag value) alist))))
(nreverse alist)))) (nreverse alist))))
@ -189,7 +187,7 @@ The alist is in the same order as the contents of the buffer."
when it has been parsed. Returns the resulting alist on success, or when it has been parsed. Returns the resulting alist on success, or
the return value of `p4-lowlevel-command-to-buffer' on failure." the return value of `p4-lowlevel-command-to-buffer' on failure."
(let ((output-buffer (p4-lowlevel-command-to-buffer args input)) (let ((output-buffer (p4-lowlevel-command-to-buffer args input))
return-value) return-value)
(setq return-value (p4-lowlevel-buffer-to-alist output-buffer)) (setq return-value (p4-lowlevel-buffer-to-alist output-buffer))
(kill-buffer output-buffer) (kill-buffer output-buffer)
return-value)) return-value))
@ -213,15 +211,8 @@ the return value of `p4-lowlevel-command-to-buffer' on failure."
(progn (progn
(setq should-ignore t) (setq should-ignore t)
(if p4-lowlevel-command-messages (if p4-lowlevel-command-messages
(message "Ignoring error: %s" error-string) (message "Ignoring error: %s" error-string))))))
) nil))
)
)
)
)
nil
)
)
(defun p4-lowlevel-successful-alist-p (output) (defun p4-lowlevel-successful-alist-p (output)
"Determines if OUTPUT, a buffer or alist, is from a successful p4 command. "Determines if OUTPUT, a buffer or alist, is from a successful p4 command.
@ -295,10 +286,10 @@ 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 output. If optional fourth argument NOERROR is true, then returns nil
rather than raising an error." rather than raising an error."
(let* (errors error-buffer return-value (let* (errors error-buffer return-value
(output-buffer (p4-lowlevel-command-to-buffer args input (output-buffer (p4-lowlevel-command-to-buffer args input
(if (bufferp output-format) (if (bufferp output-format)
output-format))) output-format)))
(output-alist (p4-lowlevel-buffer-to-alist output-buffer))) (output-alist (p4-lowlevel-buffer-to-alist output-buffer)))
(if (p4-lowlevel-successful-alist-p output-alist) t (if (p4-lowlevel-successful-alist-p output-alist) t
(setq errors (or (p4-lowlevel-errors output-alist) "Unknown error")) (setq errors (or (p4-lowlevel-errors output-alist) "Unknown error"))
(kill-buffer output-buffer) (kill-buffer output-buffer)
@ -306,7 +297,7 @@ rather than raising an error."
(if (not (string-match "\n" errors)) (if (not (string-match "\n" errors))
(error "P4 error: %s" errors) (error "P4 error: %s" errors)
(setq error-buffer (p4-lowlevel-get-buffer-create (setq error-buffer (p4-lowlevel-get-buffer-create
" *p4-lowlevel-error*")) " *p4-lowlevel-error*"))
(set-buffer error-buffer) (set-buffer error-buffer)
(erase-buffer) (erase-buffer)
(insert errors) (insert errors)
@ -335,7 +326,7 @@ buffer, then puts output in that buffer. Returns the buffer."
(let* ((output-alist (p4-lowlevel-command-or-error args)) (let* ((output-alist (p4-lowlevel-command-or-error args))
(output-buffer (if (bufferp buffer) buffer (output-buffer (if (bufferp buffer) buffer
(p4-lowlevel-get-buffer-create (p4-lowlevel-get-buffer-create
(concat " *p4-lowlevel-" buffer "*")))) (concat " *p4-lowlevel-" buffer "*"))))
text) text)
(save-excursion (save-excursion
(set-buffer output-buffer) (set-buffer output-buffer)
@ -353,9 +344,9 @@ bound and true."
(defun p4-lowlevel-canonicalize-revision (rev) (defun p4-lowlevel-canonicalize-revision (rev)
"Turn REV into a form which can be concatenated to file names in P4 "Turn REV into a form which can be concatenated to file names in P4
commands." commands."
; There is some ambiguity here, since a number can be either a ; There is some ambiguity here, since a number can be either a
; revision number (#rev) or a change number (@change). We assume ; revision number (#rev) or a change number (@change). We assume
; that a bare number is a revision number. ; that a bare number is a revision number.
(if rev (if rev
(if (eq rev t) (if (eq rev t)
nil nil
@ -367,29 +358,29 @@ commands."
(concat "@" rev) (concat "@" rev)
rev)))))) rev))))))
; Here's what we need to support from the "p4 add" command, at least ; Here's what we need to support from the "p4 add" command, at least
; for the time being: ; for the time being:
; ;
; Do NOT need to support "-c". ; Do NOT need to support "-c".
; Do NOT need to support "-t". ; Do NOT need to support "-t".
; Do NOT need to support the specification of multiple files. ; Do NOT need to support the specification of multiple files.
(defun p4-lowlevel-add (file) (defun p4-lowlevel-add (file)
"Tell Perforce to add FILE to the repository. "Tell Perforce to add FILE to the repository.
Returns nil or raises an error on failure." Returns nil or raises an error on failure."
; Note that because "p4 -s add" has bugs, at least as of p4 99.2, ; 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 ; 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. ; an attempt to add a file which already exists in the repository.
(p4-lowlevel-command-or-error (list "add" file))) (p4-lowlevel-command-or-error (list "add" file)))
; Here's what we need to support from the "p4 change" command, at ; Here's what we need to support from the "p4 change" command, at
; least for the time being: ; least for the time being:
; ;
; Do NOT need to support "-f". ; Do NOT need to support "-f".
; Do NOT need to support "-d". ; Do NOT need to support "-d".
; DO need to support "-o". ; DO need to support "-o".
; DO need to support "-i". ; DO need to support "-i".
; DO need to support specified changelist #'s. ; DO need to support specified changelist #'s.
(defun p4-lowlevel-change (&optional buffer op) (defun p4-lowlevel-change (&optional buffer op)
"Creates or edits a P4 changelist from/to BUFFER. "Creates or edits a P4 changelist from/to BUFFER.
@ -413,7 +404,7 @@ buffer is returned."
(error "P4 error: could not parse info \"%s\"" info)) (error "P4 error: could not parse info \"%s\"" info))
(if (not buffer) (if (not buffer)
(setq buffer (p4-lowlevel-get-buffer-create (setq buffer (p4-lowlevel-get-buffer-create
" *p4-lowlevel-change*"))) " *p4-lowlevel-change*")))
(save-excursion (save-excursion
(set-buffer buffer) (set-buffer buffer)
(erase-buffer) (erase-buffer)
@ -427,32 +418,32 @@ 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 `-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'." value with `-m'; if S-VAL is non-nil, pass that value with `-s'."
(setq rev1 (p4-lowlevel-canonicalize-revision rev1) (setq rev1 (p4-lowlevel-canonicalize-revision rev1)
rev2 (p4-lowlevel-canonicalize-revision rev2)) rev2 (p4-lowlevel-canonicalize-revision rev2))
(let ((full-file (let ((full-file
(if (or rev1 rev2) (if (or rev1 rev2)
(format "%s%s,%s" file-pattern (or rev1 "") (or rev2 "")) (format "%s%s,%s" file-pattern (or rev1 "") (or rev2 ""))
file-pattern)) file-pattern))
(i-list (if i-flag (list "-i"))) (i-list (if i-flag (list "-i")))
(l-list (if l-flag (list "-l"))) (l-list (if l-flag (list "-l")))
(m-list (if m-val (list "-m" (if (numberp m-val) (m-list (if m-val (list "-m" (if (numberp m-val)
(number-to-string m-val) (number-to-string m-val)
m-val)))) m-val))))
(s-list (if s-val (list "-s" s-val)))) (s-list (if s-val (list "-s" s-val))))
(p4-lowlevel-command-or-error (append (p4-lowlevel-command-or-error (append
(list "changes") (list "changes")
i-list l-list m-list s-list i-list l-list m-list s-list
(list full-file)) (list full-file))
nil output-format))) nil output-format)))
; Here's what we need to support from the "p4 diff" command, at ; Here's what we need to support from the "p4 diff" command, at
; least for the time being: ; least for the time being:
; ;
; DO need to support "-d<flag>". ; DO need to support "-d<flag>".
; DO need to support "-f" (in fact, need to specify it all the time). ; DO need to support "-f" (in fact, need to specify it all the time).
; Do NOT need to support "-s<flag>". ; 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 "-t" (in fact, need to specify it all the time).
; DO need to support diffing a single file. ; DO need to support diffing a single file.
; Do NOT need to support diffing multiple files. ; Do NOT need to support diffing multiple files.
(defun p4-lowlevel-diff (files &optional rev buffer) (defun p4-lowlevel-diff (files &optional rev buffer)
"Run `p4 diff' on FILE at revision REV and return a buffer "Run `p4 diff' on FILE at revision REV and return a buffer
@ -476,7 +467,7 @@ that buffer."
(diff-args (append (list "diff") p4-lowlevel-diff-switches (diff-args (append (list "diff") p4-lowlevel-diff-switches
(list "-f" "-t") file-specs)) (list "-f" "-t") file-specs))
(buffer (p4-lowlevel-command-into-buffer diff-args (buffer (p4-lowlevel-command-into-buffer diff-args
(or buffer "diff")))) (or buffer "diff"))))
buffer)) buffer))
(defun p4-lowlevel-diff-s (file flag) (defun p4-lowlevel-diff-s (file flag)
@ -490,13 +481,13 @@ return a list of the matching files."
(format "-s%s" flag) (format "-s%s" flag)
file)))) file))))
; Here's what we need to support from the "p4 diff2" command, at least ; Here's what we need to support from the "p4 diff2" command, at least
; for the time being: ; for the time being:
; ;
; DO need to support "-d<flag>". ; DO need to support "-d<flag>".
; Do NOT need to support "-q". ; Do NOT need to support "-q".
; DO need to support "-t" (in fact, need to specify it all the time). ; DO need to support "-t" (in fact, need to specify it all the time).
; Do NOT need to support "-b". ; Do NOT need to support "-b".
(defun p4-lowlevel-diff2 (file1 file2 &optional rev1 rev2 buffer) (defun p4-lowlevel-diff2 (file1 file2 &optional rev1 rev2 buffer)
"Run `p4 diff2' on FILE and FILE2 and return a buffer containing the "Run `p4 diff2' on FILE and FILE2 and return a buffer containing the
@ -511,28 +502,28 @@ optional BUFFER is non-nil, output goes in that buffer. Uses
(diff-args (append (list "diff2") p4-lowlevel-diff-switches (diff-args (append (list "diff2") p4-lowlevel-diff-switches
(list "-t" file1-spec file2-spec))) (list "-t" file1-spec file2-spec)))
(buffer (p4-lowlevel-command-into-buffer diff-args (buffer (p4-lowlevel-command-into-buffer diff-args
(or buffer "diff")))) (or buffer "diff"))))
buffer)) buffer))
; Here's what we need to support from the "p4 edit" command, at least ; Here's what we need to support from the "p4 edit" command, at least
; for the time being: ; for the time being:
; ;
; Do NOT need to support "-c". ; Do NOT need to support "-c".
; Do NOT need to support "-t". ; Do NOT need to support "-t".
; Do NOT need to support the specification of multiple files. ; Do NOT need to support the specification of multiple files.
(defun p4-lowlevel-edit (file) (defun p4-lowlevel-edit (file)
"Tell Perforce we want to edit FILE. "Tell Perforce we want to edit FILE.
Returns non-nil on success or nil on failure (or raises an error)." Returns non-nil on success or nil on failure (or raises an error)."
(p4-lowlevel-command-or-error (list "edit" file))) (p4-lowlevel-command-or-error (list "edit" file)))
; Here's what we need to support from the "p4 filelog" command, at ; Here's what we need to support from the "p4 filelog" command, at
; least for the time being: ; least for the time being:
; ;
; DO need to support "-i". ; DO need to support "-i".
; DO need to support "-l". ; DO need to support "-l".
; Do NOT need to support "-m". ; Do NOT need to support "-m".
; Do NOT need to support the specification of multiple files. ; Do NOT need to support the specification of multiple files.
(defun p4-lowlevel-filelog (file &optional buffer long follow-branches limit) (defun p4-lowlevel-filelog (file &optional buffer long follow-branches limit)
"Fetch the p4 log of FILE and return a buffer containing it. "Fetch the p4 log of FILE and return a buffer containing it.
@ -551,11 +542,11 @@ last LIMIT log entries."
"Fetch the string returned by running `p4 opened' on FILE." "Fetch the string returned by running `p4 opened' on FILE."
(p4-lowlevel-command-or-error (list "opened" file) nil 'string)) (p4-lowlevel-command-or-error (list "opened" file) nil 'string))
; Here's what we need to support from the "p4 fstat" command, at least ; Here's what we need to support from the "p4 fstat" command, at least
; for the time being: ; for the time being:
; ;
; Do NOT need to support any command-line switches. ; Do NOT need to support any command-line switches.
; Do NOT need to support the specification of multiple files. ; Do NOT need to support the specification of multiple files.
(defun p4-lowlevel-fstat (file &optional rev noerror) (defun p4-lowlevel-fstat (file &optional rev noerror)
"Fetch p4 information about FILE (optionally, at REV). "Fetch p4 information about FILE (optionally, at REV).
@ -568,27 +559,27 @@ files, then returns a list of lists of field-name/value elements."
(let* ((file-spec (if rev (concat file rev) file)) (let* ((file-spec (if rev (concat file rev) file))
(args (list "fstat" file-spec)) (args (list "fstat" file-spec))
(alist (p4-lowlevel-re-assoc (alist (p4-lowlevel-re-assoc
"^info" (p4-lowlevel-command-or-error args nil nil noerror))) "^info" (p4-lowlevel-command-or-error args nil nil noerror)))
element line field value values lists) element line field value values lists)
(while alist (while alist
(setq element (car alist) (setq element (car alist)
alist (cdr alist) alist (cdr alist)
line (cdr element)) line (cdr element))
(if (not (string-match " " line)) (if (not (string-match " " line))
t t
(setq field (substring line 0 (match-beginning 0)) (setq field (substring line 0 (match-beginning 0))
value (substring line (match-end 0))) value (substring line (match-end 0)))
(if (string= field "depotFile") ; we assume depotFile is (if (string= field "depotFile") ; we assume depotFile is
; always first ; always first
(if (not values) (if (not values)
t t
(setq lists (cons (nreverse values) lists)) (setq lists (cons (nreverse values) lists))
(setq values nil))) (setq values nil)))
(setq values (cons (cons field value) values)))) (setq values (cons (cons field value) values))))
(when values (when values
(setq lists (cons (nreverse values) lists))) (setq lists (cons (nreverse values) lists)))
(if (= (length lists) 1) (if (= (length lists) 1)
(car lists) (car lists)
lists))) lists)))
(defun p4-lowlevel-info () (defun p4-lowlevel-info ()
@ -618,31 +609,31 @@ QUIET is non-nil, then the `-q' flag is passed to `p4 print'."
(args (append (list "print") quiet-args (list fullfile)))) (args (append (list "print") quiet-args (list fullfile))))
(p4-lowlevel-command-or-error args nil output-format))) (p4-lowlevel-command-or-error args nil output-format)))
; Here's what we need to support from the "p4 reopen" command, at ; Here's what we need to support from the "p4 reopen" command, at
; least for the time being: ; least for the time being:
; ;
; DO need to support "-c changelist#", so that we can reopen a file in ; DO need to support "-c changelist#", so that we can reopen a file in
; the default changelist before submitting it. ; the default changelist before submitting it.
; Do NOT need to support "-t". ; Do NOT need to support "-t".
; Do NOT need to support the specification of multiple files. ; Do NOT need to support the specification of multiple files.
(defun p4-lowlevel-reopen (file &optional changelist) (defun p4-lowlevel-reopen (file &optional changelist)
"Call `p4 reopen' on FILE. "Call `p4 reopen' on FILE.
Optional CHANGELIST specifies the changelist to which to move it." Optional CHANGELIST specifies the changelist to which to move it."
(p4-lowlevel-command-or-error (append (list "reopen") (p4-lowlevel-command-or-error (append (list "reopen")
(if changelist (list "-c" changelist) nil) (if changelist (list "-c" changelist) nil)
(list file)))) (list file))))
; Here's what we need to support from the "p4 resolve" command, at ; Here's what we need to support from the "p4 resolve" command, at
; least for the time being: ; least for the time being:
; ;
; DO need to support "-af" (in fact, need to specify it all the time). ; 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 "-am", "-as", "-at", "-ay".
; Do NOT need to support "-f". ; Do NOT need to support "-f".
; Do NOT need to support "-n". ; Do NOT need to support "-n".
; DO need to support "-t" (in fact, need to specify it all the time). ; 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 "-v".
; Do NOT need to support the specification of multiple files. ; Do NOT need to support the specification of multiple files.
(defun p4-lowlevel-resolve (file) (defun p4-lowlevel-resolve (file)
"Call `p4 resolve' on FILE. "Call `p4 resolve' on FILE.
@ -650,22 +641,22 @@ Specifies the `-af' and `-t' options to ensure a non-interactive
resolve. Raises an error if the command fails." resolve. Raises an error if the command fails."
(p4-lowlevel-command-or-error (list "resolve" "-af" "-t" file))) (p4-lowlevel-command-or-error (list "resolve" "-af" "-t" file)))
; Here's what we need to support from the "p4 revert" command, at ; Here's what we need to support from the "p4 revert" command, at
; least for the time being: ; least for the time being:
; ;
; Do NOT need to support "-a". ; Do NOT need to support "-a".
; Do NOT need to support "-c". ; Do NOT need to support "-c".
; Do NOT need to support the specification of multiple files. ; Do NOT need to support the specification of multiple files.
(defun p4-lowlevel-revert (file) (defun p4-lowlevel-revert (file)
"Tell Perforce to unedit FILE." "Tell Perforce to unedit FILE."
(p4-lowlevel-command-or-error (list "revert" file))) (p4-lowlevel-command-or-error (list "revert" file)))
; Here's what we need to support from the "p4 submit" command, at ; Here's what we need to support from the "p4 submit" command, at
; least for the time being: ; least for the time being:
; ;
; Only need to support non-interactive use; therefore, only need to ; Only need to support non-interactive use; therefore, only need to
; support "p4 submit -i". ; support "p4 submit -i".
(defun p4-lowlevel-submit (change-spec) (defun p4-lowlevel-submit (change-spec)
"Calls `p4 submit' on CHANGE-SPEC, which should be a string or buffer." "Calls `p4 submit' on CHANGE-SPEC, which should be a string or buffer."
@ -673,20 +664,20 @@ resolve. Raises an error if the command fails."
(if (bufferp change-spec) (if (bufferp change-spec)
(setq buffer change-spec) (setq buffer change-spec)
(setq buffer (p4-lowlevel-get-buffer-create (setq buffer (p4-lowlevel-get-buffer-create
" *p4-lowlevel-submit-input*")) " *p4-lowlevel-submit-input*"))
(save-excursion (save-excursion
(set-buffer buffer) (set-buffer buffer)
(erase-buffer) (erase-buffer)
(insert change-spec))) (insert change-spec)))
(p4-lowlevel-command-or-error (list "submit" "-i") buffer))) (p4-lowlevel-command-or-error (list "submit" "-i") buffer)))
; Here's what we need to support from the "p4 sync" command, at least ; Here's what we need to support from the "p4 sync" command, at least
; for the time being: ; for the time being:
; ;
; DO need to support "-f". ; DO need to support "-f".
; Do NOT need to support "-n". ; Do NOT need to support "-n".
; DO need to support the specification of a file revision. ; DO need to support the specification of a file revision.
; Do NOT need to support the specification of multiple files. ; Do NOT need to support the specification of multiple files.
(defun p4-lowlevel-sync (file &optional rev force) (defun p4-lowlevel-sync (file &optional rev force)
"Call `p4 sync' for FILE. "Call `p4 sync' for FILE.
@ -703,14 +694,14 @@ optional FORCE is non-nil, pass the `-f' flag."
range specified by REV1 and REV2, forcing the integration (i.e., range specified by REV1 and REV2, forcing the integration (i.e.,
specifying `-f' to `p4 integrate' if FORCE is non-nil." specifying `-f' to `p4 integrate' if FORCE is non-nil."
(setq rev1 (p4-lowlevel-canonicalize-revision rev1) (setq rev1 (p4-lowlevel-canonicalize-revision rev1)
rev2 (p4-lowlevel-canonicalize-revision rev2)) rev2 (p4-lowlevel-canonicalize-revision rev2))
(let ((force-list (if force (list "-f"))) (let ((force-list (if force (list "-f")))
(from-full (if (or rev1 rev2) (from-full (if (or rev1 rev2)
(format "%s%s,%s" from-file (or rev1 "") (or rev2 "")) (format "%s%s,%s" from-file (or rev1 "") (or rev2 ""))
from-file))) from-file)))
(p4-lowlevel-command-or-error (append (list "integrate") (p4-lowlevel-command-or-error (append (list "integrate")
(if force (list "-f")) (if force (list "-f"))
(list from-full to-file))))) (list from-full to-file)))))
(defun p4-lowlevel-client-version (&optional noerror) (defun p4-lowlevel-client-version (&optional noerror)
"Returns the Perforce client version string from `p4 -V'. "Returns the Perforce client version string from `p4 -V'.
@ -718,9 +709,9 @@ 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 signals an error if the invocation failed. if optional NOERROR is
non-nil, returns nil instead of signalling an error." non-nil, returns nil instead of signalling an error."
(let ((version-string (p4-lowlevel-command-or-error "-V" nil 'string (let ((version-string (p4-lowlevel-command-or-error "-V" nil 'string
noerror))) noerror)))
(if (string-match "\n[^/\n]+/[^/\n]+/\\([^\n/]+\\)/.*\n?\\'" (if (string-match "\n[^/\n]+/[^/\n]+/\\([^\n/]+\\)/.*\n?\\'"
version-string) version-string)
(setq version-string (match-string 1 version-string))) (setq version-string (match-string 1 version-string)))
version-string)) version-string))

565
vc-p4.el
View file

@ -72,8 +72,8 @@
(if (not (memq 'P4 vc-handled-backends)) (if (not (memq 'P4 vc-handled-backends))
(setq vc-handled-backends (cons 'P4 vc-handled-backends))) (setq vc-handled-backends (cons 'P4 vc-handled-backends)))
; This is useful during development to ensure that we can simply ; This is useful during development to ensure that we can simply
; reeval this buffer to get any new functions that have been added. ; reeval this buffer to get any new functions that have been added.
(put 'P4 'vc-functions nil) (put 'P4 'vc-functions nil)
(defcustom vc-p4-require-p4config nil (defcustom vc-p4-require-p4config nil
@ -99,7 +99,6 @@ specify a starting date when you run C-u C-x v g."
:type 'string :type 'string
:group 'vc) :group 'vc)
(defun vc-p4-create-repo () (defun vc-p4-create-repo ()
(error "create-repo not supported yet for P4")) (error "create-repo not supported yet for P4"))
@ -150,7 +149,7 @@ compare non-open files to the depot version."
(if (string= action "add") 'added 'edited) (if (string= action "add") 'added 'edited)
'needs-merge)))) 'needs-merge))))
((and (file-exists-p file) ((and (file-exists-p file)
(not dont-compare-nonopened) (not dont-compare-nonopened)
(p4-lowlevel-diff-s file "e")) (p4-lowlevel-diff-s file "e"))
'unlocked-changes) 'unlocked-changes)
((or ((or
@ -158,8 +157,7 @@ compare non-open files to the depot version."
(and (null haveRev) (string= headAction "delete"))) (and (null haveRev) (string= headAction "delete")))
'up-to-date) 'up-to-date)
(t (t
'needs-patch))) 'needs-patch))))
)
(vc-file-setprop file 'vc-p4-did-fstat t) (vc-file-setprop file 'vc-p4-did-fstat t)
(vc-file-setprop file 'vc-p4-depot-file depotFile) (vc-file-setprop file 'vc-p4-depot-file depotFile)
(vc-file-setprop file 'vc-p4-action action) (vc-file-setprop file 'vc-p4-action action)
@ -204,7 +202,7 @@ compare non-open files to the depot version."
revision." revision."
(vc-p4-state file) (vc-p4-state file)
(string= (vc-file-getprop file 'vc-latest-version) (string= (vc-file-getprop file 'vc-latest-version)
(vc-file-getprop file 'vc-workfile-version))) (vc-file-getprop file 'vc-workfile-version)))
(defun vc-p4-checkout-model (file) (defun vc-p4-checkout-model (file)
"Returns the checkout model for Perforce (`announce')." "Returns the checkout model for Perforce (`announce')."
@ -215,23 +213,23 @@ revision."
(let ((state (vc-p4-state file))) (let ((state (vc-p4-state file)))
(and (not (equal (vc-file-getprop file 'vc-p4-action) "add")) (and (not (equal (vc-file-getprop file 'vc-p4-action) "add"))
(not (equal (vc-file-getprop file 'vc-p4-action) "delete")) (not (equal (vc-file-getprop file 'vc-p4-action) "delete"))
(or (equal state 'up-to-date) (or (equal state 'up-to-date)
(equal state 'needs-patch) (equal state 'needs-patch)
(p4-lowlevel-diff-s file "r"))))) (p4-lowlevel-diff-s file "r")))))
(defun vc-p4-mode-line-string (file) (defun vc-p4-mode-line-string (file)
"Return string for placement into the modeline for FILE. "Return string for placement into the modeline for FILE.
Compared to the default implementation, this function handles the Compared to the default implementation, this function handles the
special case of a Perforce file that is added but not yet committed." special case of a Perforce file that is added but not yet committed."
(let ((state (vc-state file)) (let ((state (vc-state file))
(rev (vc-workfile-version file))) (rev (vc-workfile-version file)))
(if (or (not rev) (string= rev "0")) (if (or (not rev) (string= rev "0"))
(setq rev "@@")) (setq rev "@@"))
(cond ((or (eq state 'up-to-date) (cond ((or (eq state 'up-to-date)
(eq state 'needs-patch)) (eq state 'needs-patch))
(concat "P4-" rev)) (concat "P4-" rev))
((stringp state) ((stringp state)
(concat "P4:" state ":" rev)) (concat "P4:" state ":" rev))
(t (t
;; Not just for the 'edited state, but also a fallback ;; Not just for the 'edited state, but also a fallback
;; for all other states. Think about different symbols ;; for all other states. Think about different symbols
@ -247,21 +245,21 @@ special case of a Perforce file that is added but not yet committed."
;; before it used to be just a single file. We don't support that ;; before it used to be just a single file. We don't support that
;; interface yet, so just use the first file in the list. ;; interface yet, so just use the first file in the list.
(let* ((file (if (listp files) (car files) files)) (let* ((file (if (listp files) (car files) files))
(fstat (p4-lowlevel-fstat file nil t)) (fstat (p4-lowlevel-fstat file nil t))
(action (cdr (assoc "action" fstat)))) (action (cdr (assoc "action" fstat))))
(if (string= action "delete") (if (string= action "delete")
(if (yes-or-no-p (if (yes-or-no-p
"File already opened for delete; revert and edit it? ") "File already opened for delete; revert and edit it? ")
(progn (progn
(if (yes-or-no-p "Preserve current contents? ") (if (yes-or-no-p "Preserve current contents? ")
(let ((tempfile (format "%s.vc-register~" file))) (let ((tempfile (format "%s.vc-register~" file)))
(rename-file file tempfile) (rename-file file tempfile)
(p4-lowlevel-revert file) (p4-lowlevel-revert file)
(delete-file file) (delete-file file)
(rename-file tempfile file)) (rename-file tempfile file))
(p4-lowlevel-revert file)) (p4-lowlevel-revert file))
(p4-lowlevel-edit file)) (p4-lowlevel-edit file))
(error "File %s already opened for delete." file)) (error "File %s already opened for delete." file))
(p4-lowlevel-add file)))) (p4-lowlevel-add file))))
(defun vc-p4-init-revision () (defun vc-p4-init-revision ()
@ -272,13 +270,13 @@ special case of a Perforce file that is added but not yet committed."
"Returns true if FILE refers to a file or directory that is "Returns true if FILE refers to a file or directory that is
administered by Perforce." administered by Perforce."
(if (and vc-p4-require-p4config (if (and vc-p4-require-p4config
(getenv "P4CONFIG") (getenv "P4CONFIG")
(not (vc-p4-find-p4config file))) (not (vc-p4-find-p4config file)))
nil nil
(or (p4-lowlevel-fstat file nil t) (or (p4-lowlevel-fstat file nil t)
(vc-p4-is-in-client (if (file-directory-p file) (vc-p4-is-in-client (if (file-directory-p file)
(file-name-as-directory file) (file-name-as-directory file)
file))))) file)))))
(defun vc-p4-find-version (file rev buffer) (defun vc-p4-find-version (file rev buffer)
(p4-lowlevel-print file rev buffer t)) (p4-lowlevel-print file rev buffer t))
@ -289,13 +287,13 @@ comment COMMENT."
(if rev (if rev
(error "Can't specify revision for Perforce checkin.")) (error "Can't specify revision for Perforce checkin."))
(let* (;; XXX: default-directory? this should work for most (all?) cases (let* (;; XXX: default-directory? this should work for most (all?) cases
(default-directory (file-name-directory (car files))) (default-directory (file-name-directory (car files)))
(change-buffer (p4-lowlevel-change)) (change-buffer (p4-lowlevel-change))
(indent-tabs-mode 1) (indent-tabs-mode 1)
insertion-start change-number) insertion-start change-number)
(dolist (file files) (dolist (file files)
(if (vc-p4-has-unresolved-conflicts-p file) (if (vc-p4-has-unresolved-conflicts-p file)
(error "File %s has unresolved conflicts" file))) (error "File %s has unresolved conflicts" file)))
(save-excursion (save-excursion
(set-buffer change-buffer) (set-buffer change-buffer)
(goto-char (point-min)) (goto-char (point-min))
@ -307,13 +305,13 @@ comment COMMENT."
(re-search-forward "^Files:\\s-*\n") (re-search-forward "^Files:\\s-*\n")
(delete-region (point) (point-max)) (delete-region (point) (point-max))
(dolist (file files) (dolist (file files)
(insert "\t" (vc-file-getprop file 'vc-p4-depot-file) "\n")) (insert "\t" (vc-file-getprop file 'vc-p4-depot-file) "\n"))
(setq change-number (p4-lowlevel-change (current-buffer) t)) (setq change-number (p4-lowlevel-change (current-buffer) t))
(p4-lowlevel-change (current-buffer) change-number) (p4-lowlevel-change (current-buffer) change-number)
(p4-lowlevel-submit (current-buffer)) (p4-lowlevel-submit (current-buffer))
; Update its properties ; Update its properties
(dolist (file files) (dolist (file files)
(vc-p4-state file nil t))))) (vc-p4-state file nil t)))))
;;; FIXME: this should not have a DESTFILE argument ;;; FIXME: this should not have a DESTFILE argument
(defun vc-p4-checkout (file &optional editable rev destfile) (defun vc-p4-checkout (file &optional editable rev destfile)
@ -322,8 +320,8 @@ comment COMMENT."
(if (string= file destfile) (if (string= file destfile)
(setq destfile nil)) (setq destfile nil))
(let ((default-directory (file-name-directory file)) (let ((default-directory (file-name-directory file))
buffer) buffer)
; Make sure we've got all the current state of the file ; Make sure we've got all the current state of the file
(vc-p4-state file) (vc-p4-state file)
(cond (cond
((not rev) ((not rev)
@ -331,13 +329,13 @@ comment COMMENT."
((string= rev "") ((string= rev "")
(setq rev (vc-file-getprop file 'vc-latest-version)))) (setq rev (vc-file-getprop file 'vc-latest-version))))
(if destfile (if destfile
(progn (setq buffer (p4-lowlevel-print file rev 'buffer t)) (progn (setq buffer (p4-lowlevel-print file rev 'buffer t))
(set-buffer buffer) (set-buffer buffer)
(write-file destfile)) (write-file destfile))
(if (not (string= rev (vc-file-getprop file 'vc-workfile-version))) (if (not (string= rev (vc-file-getprop file 'vc-workfile-version)))
(p4-lowlevel-sync file rev)) (p4-lowlevel-sync file rev))
(if editable (if editable
(p4-lowlevel-edit file)))) (p4-lowlevel-edit file))))
(vc-p4-state file nil t)) (vc-p4-state file nil t))
(defun vc-p4-revert (file contents-done) (defun vc-p4-revert (file contents-done)
@ -351,7 +349,7 @@ comment COMMENT."
(t (t
(p4-lowlevel-revert file))) (p4-lowlevel-revert file)))
(if (string= action "add") (if (string= action "add")
(vc-file-clearprops file) (vc-file-clearprops file)
(vc-p4-state file nil t)))) (vc-p4-state file nil t))))
(defun vc-p4-merge (file rev1 rev2) (defun vc-p4-merge (file rev1 rev2)
@ -387,9 +385,9 @@ comment COMMENT."
"Steal Perforce lock on FILE." "Steal Perforce lock on FILE."
(if (and version (not (equal version (vc-workfile-version file)))) (if (and version (not (equal version (vc-workfile-version file))))
(error "Can't specify version when stealing Perforce lock.")) (error "Can't specify version when stealing Perforce lock."))
; Must set default-directory because this is called in a mail send ; 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 ; hook and thus not with the current buffer set to the file being
; reopened. ; reopened.
(let ((default-directory (file-name-directory file))) (let ((default-directory (file-name-directory file)))
(p4-lowlevel-reopen file))) (p4-lowlevel-reopen file)))
@ -403,14 +401,14 @@ comment COMMENT."
;; the command. ;; the command.
(vc-setup-buffer buffer) (vc-setup-buffer buffer)
(let* ((inhibit-read-only t) (let* ((inhibit-read-only t)
;; In emacs-23 vc-print-log has a list of files as a ;; In emacs-23 vc-print-log has a list of files as a
;; parameter, before it used to be just a single file. We ;; parameter, before it used to be just a single file. We
;; don't support that interface yet, so just use the first ;; don't support that interface yet, so just use the first
;; file in the list. ;; file in the list.
(file (if (listp files) (car files) files)) (file (if (listp files) (car files) files))
(default-directory (file-name-directory file))) (default-directory (file-name-directory file)))
(with-current-buffer (with-current-buffer
buffer buffer
(p4-lowlevel-filelog file (current-buffer) (not shortlog) nil limit) (p4-lowlevel-filelog file (current-buffer) (not shortlog) nil limit)
;; Insert the file name at the beginning. ;; Insert the file name at the beginning.
(goto-char (point-min)) (goto-char (point-min))
@ -425,27 +423,27 @@ current buffer."
(beginning-of-line) (beginning-of-line)
(setq start (point)) (setq start (point))
(if (not (search-forward "\n#" nil t)) (if (not (search-forward "\n#" nil t))
(setq end (point-max)) (setq end (point-max))
(beginning-of-line) (beginning-of-line)
(setq end (point))) (setq end (point)))
(setq lines (count-lines start end)) (setq lines (count-lines start end))
(cond (cond
;; if the global information and this log entry fit ;; if the global information and this log entry fit
;; into the window, display from the beginning ;; into the window, display from the beginning
((< (count-lines (point-min) end) (window-height)) ((< (count-lines (point-min) end) (window-height))
(goto-char (point-min)) (goto-char (point-min))
(recenter 0) (recenter 0)
(goto-char start)) (goto-char start))
;; if the whole entry fits into the window, ;; if the whole entry fits into the window,
;; display it centered ;; display it centered
((< (1+ lines) (window-height)) ((< (1+ lines) (window-height))
(goto-char start) (goto-char start)
(recenter (1- (- (/ (window-height) 2) (/ lines 2))))) (recenter (1- (- (/ (window-height) 2) (/ lines 2)))))
;; otherwise (the entry is too large for the window), ;; otherwise (the entry is too large for the window),
;; display from the start ;; display from the start
(t (t
(goto-char start) (goto-char start)
(recenter 0)))))) (recenter 0))))))
(defun vc-p4-wash-log (file) (defun vc-p4-wash-log (file)
"Remove all non-comment information from the Perforce log in the "Remove all non-comment information from the Perforce log in the
@ -457,35 +455,35 @@ current buffer."
"Create ChangeLog entriers for FILES if it's non-nil, or for all "Create ChangeLog entriers for FILES if it's non-nil, or for all
files under the default directory otherwise." files under the default directory otherwise."
(let ((odefault default-directory) (let ((odefault default-directory)
(changelog (find-change-log)) (changelog (find-change-log))
default-directory start-rev end-rev) default-directory start-rev end-rev)
(find-file-other-window changelog) (find-file-other-window changelog)
(setq default-directory odefault) (setq default-directory odefault)
(goto-char (point-min)) (goto-char (point-min))
(if (looking-at (if (looking-at
"^\\([0-9]\\{4\\}\\)[-/]\\([0-9]\\{2\\}\\)[-/]\\([0-9]\\{2\\}\\) ") "^\\([0-9]\\{4\\}\\)[-/]\\([0-9]\\{2\\}\\)[-/]\\([0-9]\\{2\\}\\) ")
(setq start-rev (format "@%s/%s/%s" (setq start-rev (format "@%s/%s/%s"
(match-string 1) (match-string 1)
(match-string 2) (match-string 2)
(match-string 3)) (match-string 3))
end-rev "@now")) end-rev "@now"))
(if (not files) (if (not files)
(setq files "...")) (setq files "..."))
(message "Computing change log entries...") (message "Computing change log entries...")
(insert (p4-lowlevel-info-lines (insert (p4-lowlevel-info-lines
(p4-lowlevel-changes files nil start-rev end-rev (p4-lowlevel-changes files nil start-rev end-rev
nil t nil "submitted"))) nil t nil "submitted")))
(if (= (point) (point-min)) t (if (= (point) (point-min)) t
(if (not (= (point) (point-max))) (if (not (= (point) (point-max)))
(insert "\n")) (insert "\n"))
(while (re-search-backward (while (re-search-backward
(concat "^Change [0-9]+ on \\([0-9]+\\)/" (concat "^Change [0-9]+ on \\([0-9]+\\)/"
"\\([0-9]+\\)/\\([0-9]+\\) by \\(.+\\)") "\\([0-9]+\\)/\\([0-9]+\\) by \\(.+\\)")
nil t nil) nil t nil)
(replace-match "\n\\1-\\2-\\3 \\4" t)) (replace-match "\n\\1-\\2-\\3 \\4" t))
(goto-char (point-min)) (goto-char (point-min))
(if (looking-at "\n") (if (looking-at "\n")
(kill-line))) (kill-line)))
(message "Computing change log entries... done"))) (message "Computing change log entries... done")))
(defvar log-view-message-re) (defvar log-view-message-re)
@ -499,16 +497,16 @@ files under the default directory otherwise."
"^#\\([0-9]+\\) .*") "^#\\([0-9]+\\) .*")
(set (make-local-variable 'log-view-font-lock-keywords) (set (make-local-variable 'log-view-font-lock-keywords)
(append `((,log-view-message-re . 'log-view-message-face) (append `((,log-view-message-re . 'log-view-message-face)
(,log-view-file-re . 'log-view-file-face)) (,log-view-file-re . 'log-view-file-face))
'(("^user:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)" '(("^user:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
(1 'change-log-email)) (1 'change-log-email))
;; Handle the case: ;; Handle the case:
;; user: FirstName LastName <foo@bar> ;; user: FirstName LastName <foo@bar>
("^user:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" ("^user:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
(1 'change-log-name) (1 'change-log-name)
(2 'change-log-email)) (2 'change-log-email))
("^date: \\(.+\\)" (1 'change-log-date)) ("^date: \\(.+\\)" (1 'change-log-date))
("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))) ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))
(defun vc-p4-diff (file-or-files &optional rev1 rev2 buff) (defun vc-p4-diff (file-or-files &optional rev1 rev2 buff)
"Do a Perforce diff." "Do a Perforce diff."
@ -614,17 +612,17 @@ files under the default directory otherwise."
Annotate version VERSION if it's specified." Annotate version VERSION if it's specified."
(if vc-p4-annotate-command (if vc-p4-annotate-command
(let ((full-file (if version (let ((full-file (if version
(concat file (concat file
(p4-lowlevel-canonicalize-revision version)) (p4-lowlevel-canonicalize-revision version))
file)) file))
(starting-date (if current-prefix-arg (starting-date (if current-prefix-arg
(read-string "Starting date: (default none) "))) (read-string "Starting date: (default none) ")))
log-buffer times args) log-buffer times args)
(setq args (append (list buffer nil vc-p4-annotate-command nil) (setq args (append (list buffer nil vc-p4-annotate-command nil)
(if starting-date (if starting-date
(list "--after" starting-date)) (list "--after" starting-date))
(list full-file))) (list full-file)))
(apply 'vc-do-command args)) (apply 'vc-do-command args))
(vc-p4-annotate-command-internal file buffer version))) (vc-p4-annotate-command-internal file buffer version)))
;;; Adapted from p4.el ;;; Adapted from p4.el
@ -637,12 +635,12 @@ Read lines are deleted from buffer."
(forward-line) (forward-line)
(let ((line (buffer-substring (point-min) (point)))) (let ((line (buffer-substring (point-min) (point))))
(if (string= line "") (if (string= line "")
nil nil
(delete-region (point-min) (point)) (delete-region (point-min) (point))
;; remove trailing newline ;; remove trailing newline
(if (equal (substring line (1- (length line)) (length line)) "\n") (if (equal (substring line (1- (length line)) (length line)) "\n")
(substring line 0 (1- (length line))) (substring line 0 (1- (length line)))
line))))) line)))))
;;; Adapted from p4.el ;;; Adapted from p4.el
(defun vc-p4-annotate-command-internal (file buffer &optional version) (defun vc-p4-annotate-command-internal (file buffer &optional version)
@ -652,206 +650,205 @@ Optional arg VERSION is a version to annotate from."
(vc-setup-buffer buffer) (vc-setup-buffer buffer)
;; (with-current-buffer buffer ;; (with-current-buffer buffer
(let ((file-name file) (let ((file-name file)
(file-spec file) (file-spec file)
(blame-branch-regex (blame-branch-regex
"^\\.\\.\\. \\.\\.\\. branch from \\(//[^#]*\\)#") "^\\.\\.\\. \\.\\.\\. branch from \\(//[^#]*\\)#")
(blame-change-regex (blame-change-regex
(concat "^\\.\\.\\. #" "\\([0-9]+\\)" ;; revision (concat "^\\.\\.\\. #" "\\([0-9]+\\)" ;; revision
"\\s-+change\\s-+" "\\([0-9]+\\)" ;; change "\\s-+change\\s-+" "\\([0-9]+\\)" ;; change
"\\s-+" "\\([^ \t]+\\)" ;; type "\\s-+" "\\([^ \t]+\\)" ;; type
"\\s-+on\\s-+" "\\([^ \t]+\\)" ;; date "\\s-+on\\s-+" "\\([^ \t]+\\)" ;; date
"\\s-+by\\s-+" "\\([^ \t]+\\)" ;; author "\\s-+by\\s-+" "\\([^ \t]+\\)" ;; author
"@")) "@"))
head-name ;; file spec of the head revision for this blame assignment head-name ;; file spec of the head revision for this blame assignment
branch-p ;; have we tracked into a branch? branch-p ;; have we tracked into a branch?
cur-file ;; file name of the current branch during blame assignment cur-file ;; file name of the current branch during blame assignment
change ch-alist fullname head-rev headseen) change ch-alist fullname head-rev headseen)
;; we asked for blame constrained by a change number ;; we asked for blame constrained by a change number
(if (string-match "\\(.*\\)@\\([0-9]+\\)" file-spec) (if (string-match "\\(.*\\)@\\([0-9]+\\)" file-spec)
(progn (progn
(setq file-name (match-string 1 file-spec)) (setq file-name (match-string 1 file-spec))
(setq change (string-to-number (match-string 2 file-spec))))) (setq change (string-to-number (match-string 2 file-spec)))))
;; we asked for blame constrained by a revision ;; we asked for blame constrained by a revision
(if (string-match "\\(.*\\)#\\([0-9]+\\)" file-spec) (if (string-match "\\(.*\\)#\\([0-9]+\\)" file-spec)
(progn (progn
(setq file-name (match-string 1 file-spec)) (setq file-name (match-string 1 file-spec))
(setq head-rev (string-to-number (match-string 2 file-spec))))) (setq head-rev (string-to-number (match-string 2 file-spec)))))
;; make sure the filespec is unambiguous ;; make sure the filespec is unambiguous
;;(p4-exec-p4 buffer (list "files" file-name) t) ;;(p4-exec-p4 buffer (list "files" file-name) t)
(with-temp-buffer (with-temp-buffer
(vc-p4-command (current-buffer) nil nil "files" file-name) (vc-p4-command (current-buffer) nil nil "files" file-name)
(save-excursion (save-excursion
;; (set-buffer buffer) ;; (set-buffer buffer)
(if (> (count-lines (point-min) (point-max)) 1) (if (> (count-lines (point-min) (point-max)) 1)
(error "File pattern maps to more than one file."))) (error "File pattern maps to more than one file."))))
)
;; get the file change history: ;; get the file change history:
;;(p4-exec-p4 buffer (list "filelog" "-i" file-spec) t) ;;(p4-exec-p4 buffer (list "filelog" "-i" file-spec) t)
(with-temp-buffer (with-temp-buffer
(vc-p4-command (current-buffer) 0 nil "filelog" "-i" file-spec) (vc-p4-command (current-buffer) 0 nil "filelog" "-i" file-spec)
(setq fullname (vc-p4-read-output (current-buffer)) (setq fullname (vc-p4-read-output (current-buffer))
cur-file fullname cur-file fullname
head-name fullname) head-name fullname)
;; parse the history: ;; parse the history:
(save-excursion (save-excursion
;; (set-buffer buffer) ;; (set-buffer buffer)
(goto-char (point-min)) (goto-char (point-min))
(while (< (point) (point-max)) (while (< (point) (point-max))
;; record the current file name (and the head file name, ;; record the current file name (and the head file name,
;; if we have not yet seen one): ;; if we have not yet seen one):
(if (looking-at "^\\(//.*\\)$") (if (looking-at "^\\(//.*\\)$")
(setq cur-file (match-string 1))) (setq cur-file (match-string 1)))
;; a non-branch change: ;; a non-branch change:
(if (looking-at blame-change-regex) (if (looking-at blame-change-regex)
(let ((rev (string-to-number (match-string 1))) (let ((rev (string-to-number (match-string 1)))
(ch (string-to-number (match-string 2))) (ch (string-to-number (match-string 2)))
(op (match-string 3)) (op (match-string 3))
(date (match-string 4)) (date (match-string 4))
(author (match-string 5))) (author (match-string 5)))
(cond (cond
;; after the change constraint, OR ;; after the change constraint, OR
;; after the revision constraint _for this file_ ;; after the revision constraint _for this file_
;; [remember, branches complicate this]: ;; [remember, branches complicate this]:
((or (and change (< change ch)) ((or (and change (< change ch))
(and head-rev (< head-rev rev) (and head-rev (< head-rev rev)
(string= head-name cur-file))) nil) (string= head-name cur-file))) nil)
;; file has been deleted, can't assign blame: ;; file has been deleted, can't assign blame:
((string= op "delete") ((string= op "delete")
(if (not headseen) (goto-char (point-max)))) (if (not headseen) (goto-char (point-max))))
;; OK, we actually want to look at this one: ;; OK, we actually want to look at this one:
(t (t
(setq ch-alist (setq ch-alist
(cons (cons
(cons ch (list rev date author cur-file)) ch-alist)) (cons ch (list rev date author cur-file)) ch-alist))
(if (not head-rev) (setq head-rev rev)) (if (not head-rev) (setq head-rev rev))
(setq headseen t)) )) (setq headseen t))))
;; not if we have entered a branch (this used to be used, isn't ;; not if we have entered a branch (this used to be used, isn't
;; right now - maybe again later: ;; right now - maybe again later:
(if (and headseen (looking-at blame-branch-regex)) (if (and headseen (looking-at blame-branch-regex))
(setq branch-p t)) ) (setq branch-p t)))
(forward-line)))) (forward-line))))
(if (< (length ch-alist) 1) (if (< (length ch-alist) 1)
(error "Head revision not available")) (error "Head revision not available"))
(let ((base-ch (int-to-string (caar ch-alist))) (let ((base-ch (int-to-string (caar ch-alist)))
(ch-buffer (get-buffer-create " *p4-ch-buf*")) (ch-buffer (get-buffer-create " *p4-ch-buf*"))
(tmp-alst (copy-alist ch-alist))) (tmp-alst (copy-alist ch-alist)))
;; (p4-exec-p4 ch-buffer (list "print" "-q" (concat cur-file "@" base-ch)) t) ;; (p4-exec-p4 ch-buffer (list "print" "-q" (concat cur-file "@" base-ch)) t)
(vc-p4-command ch-buffer nil nil "print" "-q" (concat cur-file "@" base-ch)) (vc-p4-command ch-buffer nil nil "print" "-q" (concat cur-file "@" base-ch))
(save-excursion (save-excursion
(set-buffer ch-buffer) (set-buffer ch-buffer)
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward ".*\n" nil t) (while (re-search-forward ".*\n" nil t)
(replace-match (concat base-ch "\n")))) (replace-match (concat base-ch "\n"))))
(while (> (length tmp-alst) 1) (while (> (length tmp-alst) 1)
(let ((ch-1 (car (car tmp-alst))) (let ((ch-1 (car (car tmp-alst)))
(ch-2 (car (cadr tmp-alst))) (ch-2 (car (cadr tmp-alst)))
(file1 (nth 3 (cdr (car tmp-alst)))) (file1 (nth 3 (cdr (car tmp-alst))))
(file2 (nth 3 (cdr (cadr tmp-alst)))) (file2 (nth 3 (cdr (cadr tmp-alst))))
(blame-revision-regex (blame-revision-regex
(concat "^\\([0-9]+\\),?" (concat "^\\([0-9]+\\),?"
"\\([0-9]*\\)" "\\([0-9]*\\)"
"\\([acd]\\)" "\\([acd]\\)"
"\\([0-9]+\\),?" "\\([0-9]+\\),?"
"\\([0-9]*\\)")) "\\([0-9]*\\)"))
ins-string) ins-string)
(setq ins-string (format "%d\n" ch-2)) (setq ins-string (format "%d\n" ch-2))
;; (p4-exec-p4 buffer (list "diff2" ;; (p4-exec-p4 buffer (list "diff2"
;; (format "%s@%d" file1 ch-1) ;; (format "%s@%d" file1 ch-1)
;; (format "%s@%d" file2 ch-2)) t) ;; (format "%s@%d" file2 ch-2)) t)
(with-temp-buffer (with-temp-buffer
(vc-p4-command (current-buffer) nil nil (vc-p4-command (current-buffer) nil nil
"diff2" (format "%s@%d" file1 ch-1) "diff2" (format "%s@%d" file1 ch-1)
(format "%s@%d" file2 ch-2)) (format "%s@%d" file2 ch-2))
(save-excursion (save-excursion
;;(set-buffer buffer) ;;(set-buffer buffer)
(goto-char (point-max)) (goto-char (point-max))
(while (re-search-backward blame-revision-regex nil t) (while (re-search-backward blame-revision-regex nil t)
(let ((la (string-to-number (match-string 1))) (let ((la (string-to-number (match-string 1)))
(lb (string-to-number (match-string 2))) (lb (string-to-number (match-string 2)))
(op (match-string 3)) (op (match-string 3))
(ra (string-to-number (match-string 4))) (ra (string-to-number (match-string 4)))
(rb (string-to-number (match-string 5)))) (rb (string-to-number (match-string 5))))
(if (= lb 0) (if (= lb 0)
(setq lb la)) (setq lb la))
(if (= rb 0) (if (= rb 0)
(setq rb ra)) (setq rb ra))
(cond ((string= op "a") (cond ((string= op "a")
(setq la (1+ la))) (setq la (1+ la)))
((string= op "d") ((string= op "d")
(setq ra (1+ ra)))) (setq ra (1+ ra))))
(save-excursion (save-excursion
(set-buffer ch-buffer) (set-buffer ch-buffer)
(goto-line la) (goto-line la)
(let ((beg (point))) (let ((beg (point)))
(forward-line (1+ (- lb la))) (forward-line (1+ (- lb la)))
(delete-region beg (point))) (delete-region beg (point)))
(while (<= ra rb) (while (<= ra rb)
(insert ins-string) (insert ins-string)
(setq ra (1+ ra)))))))) (setq ra (1+ ra))))))))
(setq tmp-alst (cdr tmp-alst)))) (setq tmp-alst (cdr tmp-alst))))
;; (p4-noinput-buffer-action "print" nil t ;; (p4-noinput-buffer-action "print" nil t
;; (list (format "%s#%d" fullname head-rev)) ;; (list (format "%s#%d" fullname head-rev))
;; t) ;; t)
(vc-p4-command buffer nil nil (vc-p4-command buffer nil nil
"print" (format "%s#%d" fullname head-rev)) "print" (format "%s#%d" fullname head-rev))
(let (line cnum (old-cnum 0) change-data (let (line cnum (old-cnum 0) change-data
(blame-index-regex (blame-index-regex
(concat " *\\([0-9]+/[0-9]+/[0-9]+\\)" ;; date (concat " *\\([0-9]+/[0-9]+/[0-9]+\\)" ;; date
"\\s-+\\([^ \t]*\\)" ;; author "\\s-+\\([^ \t]*\\)" ;; author
" *\\([0-9]+\\)" ;; change " *\\([0-9]+\\)" ;; change
" *\\([0-9]+\\)" ;; revision " *\\([0-9]+\\)" ;; revision
" ")) " "))
xth-rev xth-date xth-auth xth-file) xth-rev xth-date xth-auth xth-file)
(save-excursion (save-excursion
(set-buffer buffer) (set-buffer buffer)
(goto-line 2) (goto-line 2)
(move-to-column 0) (move-to-column 0)
(insert (format "%10s %7s %6s %4s\n" "Date" "Author" "Change" "Rev")) (insert (format "%10s %7s %6s %4s\n" "Date" "Author" "Change" "Rev"))
(while (setq line (vc-p4-read-output ch-buffer)) (while (setq line (vc-p4-read-output ch-buffer))
(setq cnum (string-to-number line)) (setq cnum (string-to-number line))
(if (and nil (= cnum old-cnum)) (if (and nil (= cnum old-cnum))
(insert (format "%29s " "")) (insert (format "%29s " ""))
;; extract the change data from our alist: remember, ;; extract the change data from our alist: remember,
;; `eq' works for integers so we can use assq here: ;; `eq' works for integers so we can use assq here:
(setq change-data (cdr (assq cnum ch-alist)) (setq change-data (cdr (assq cnum ch-alist))
xth-rev (nth 0 change-data) xth-rev (nth 0 change-data)
xth-date (nth 1 change-data) xth-date (nth 1 change-data)
xth-auth (nth 2 change-data) xth-auth (nth 2 change-data)
xth-file (nth 3 change-data)) xth-file (nth 3 change-data))
(insert (insert
(format "%10s %7s %6d %4d " xth-date xth-auth cnum xth-rev)) (format "%10s %7s %6d %4d " xth-date xth-auth cnum xth-rev))
(move-to-column 0) (move-to-column 0)
(if (looking-at blame-index-regex) (if (looking-at blame-index-regex)
(let ((nth-cnum (match-string 3)) (let ((nth-cnum (match-string 3))
(nth-revn (match-string 4)) (nth-revn (match-string 4))
(nth-user (match-string 2))) (nth-user (match-string 2)))
;; truncate the user name: ;; truncate the user name:
(let ((start (+ (match-beginning 2) 7)) (let ((start (+ (match-beginning 2) 7))
(end (match-end 2))) (end (match-end 2)))
(if (> end start) (if (> end start)
(delete-region start end)))))) (delete-region start end))))))
(setq old-cnum cnum) (setq old-cnum cnum)
(forward-line)))) (forward-line))))
(kill-buffer ch-buffer)))) (kill-buffer ch-buffer))))
(defconst vc-p4-annotate-re (defconst vc-p4-annotate-re
(concat "^\\([[:digit:]/]+\\)[[:space:]]*[[:digit:]]+[[:space:]]+" (concat "^\\([[:digit:]/]+\\)[[:space:]]*[[:digit:]]+[[:space:]]+"
"[^[:space:]]+[[:space:]]+\\([[:digit:]]+\\)" "[^[:space:]]+[[:space:]]+\\([[:digit:]]+\\)"
"[[:space:]]+\\([[:digit:]]+\\) ")) "[[:space:]]+\\([[:digit:]]+\\) "))
(defun vc-p4-annotate-time () (defun vc-p4-annotate-time ()
"Returns the time of the next Perforce annotation at or after point, "Returns the time of the next Perforce annotation at or after point,
@ -863,9 +860,9 @@ Moves the point to the end of the annotation."
(string-match "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)" timestr) (string-match "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)" timestr)
(vc-annotate-convert-time (vc-annotate-convert-time
(encode-time 0 0 0 (encode-time 0 0 0
(string-to-number (match-string 3 timestr)) (string-to-number (match-string 3 timestr))
(string-to-number (match-string 2 timestr)) (string-to-number (match-string 2 timestr))
(string-to-number (match-string 1 timestr))))))) (string-to-number (match-string 1 timestr)))))))
(defun vc-p4-annotate-extract-revision-at-line () (defun vc-p4-annotate-extract-revision-at-line ()
(save-excursion (save-excursion
@ -880,17 +877,17 @@ Moves the point to the end of the annotation."
"See if there is a $P4CONFIG file in DIRNAME or any of its parents. "See if there is a $P4CONFIG file in DIRNAME or any of its parents.
If DIRNAME is not specified, uses `default-directory'." If DIRNAME is not specified, uses `default-directory'."
(let ((this-directory (expand-file-name (or dirname default-directory))) (let ((this-directory (expand-file-name (or dirname default-directory)))
(p4config (getenv "P4CONFIG")) (p4config (getenv "P4CONFIG"))
child) child)
(if (not p4config) (if (not p4config)
nil nil
(catch 'found (catch 'found
(while (not (equal this-directory child)) (while (not (equal this-directory child))
(if (file-exists-p (concat this-directory p4config)) (if (file-exists-p (concat this-directory p4config))
(throw 'found (concat this-directory p4config))) (throw 'found (concat this-directory p4config)))
(setq child this-directory) (setq child this-directory)
(setq this-directory (file-name-directory (setq this-directory (file-name-directory
(directory-file-name this-directory)))))))) (directory-file-name this-directory))))))))
(defun vc-p4-is-in-client (file) (defun vc-p4-is-in-client (file)
"Return true if FILE is inside the p4 client hierarchy." "Return true if FILE is inside the p4 client hierarchy."
@ -934,7 +931,7 @@ subblock within it."
block1-start (match-end 0)) block1-start (match-end 0))
(if (not (re-search-forward "^<<<<\\( .*\\|\\)\n" nil t)) (if (not (re-search-forward "^<<<<\\( .*\\|\\)\n" nil t))
nil nil
; Could actually be block 3, but but we'll figure that out later. ; Could actually be block 3, but but we'll figure that out later.
(setq block2-end (match-beginning 0) (setq block2-end (match-beginning 0)
block-end (match-end 0)) block-end (match-end 0))
(goto-char block1-start) (goto-char block1-start)
@ -959,7 +956,7 @@ subblock within it."
WHICH should be either 1, 2, or 3 to indicate the first, second or WHICH should be either 1, 2, or 3 to indicate the first, second or
third subblock in each conflict block." third subblock in each conflict block."
(let (block-list block-start block-end sub-start sub-end sublist subcount (let (block-list block-start block-end sub-start sub-end sublist subcount
replacement) replacement)
(save-excursion (save-excursion
(set-buffer buffer) (set-buffer buffer)
(while (setq block-list (vc-p4-has-unresolved-conflicts-p buffer)) (while (setq block-list (vc-p4-has-unresolved-conflicts-p buffer))
@ -971,7 +968,7 @@ third subblock in each conflict block."
subcount (1- subcount))) subcount (1- subcount)))
(setq replacement (if block-list (setq replacement (if block-list
(buffer-substring (car block-list) (buffer-substring (car block-list)
(cadr block-list)) (cadr block-list))
"")) ""))
(delete-region block-start block-end) (delete-region block-start block-end)
(goto-char block-start) (goto-char block-start)