commit b69b02ad08837d0e3e97e00aceff300ee8969f64 Author: Jonathan Kamens Date: Sat Jan 5 19:45:11 2002 -0800 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] diff --git a/p4-lowlevel.el b/p4-lowlevel.el new file mode 100644 index 0000000..7f496df --- /dev/null +++ b/p4-lowlevel.el @@ -0,0 +1,680 @@ +;;; p4-lowlwevel.el --- low-level support for Perforce operations in Emacs + +;; Copyright (C) 2002 Curl Corporation. + +;; Author: Jonathan Kamens +;; Maintainer: Jonathan Kamens + +;; $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". +; DO need to support "-f" (in fact, need to specify it all the time). +; Do NOT need to support "-s". +; 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". +; 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) diff --git a/vc-p4.el b/vc-p4.el new file mode 100644 index 0000000..e6d26b9 --- /dev/null +++ b/vc-p4.el @@ -0,0 +1,745 @@ +;;; vc-p4.el --- Integrate Perforce support into VC mode in Emacs 21 + +;; Copyright (C) 2002 Curl Corporation. + +;; Author: Jonathan Kamens +;; Maintainer: Jonathan Kamens + +;; $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)