983 lines
40 KiB
EmacsLisp
983 lines
40 KiB
EmacsLisp
;;; vc-p4.el --- Integrate Perforce support into VC mode in Emacs 21
|
|
|
|
;; Copyright (C) 2009, 2010 Magnus Henoch
|
|
;; Copyright (C) 2002 Curl Corporation.
|
|
|
|
;; Author: Jonathan Kamens <jik@kamens.brookline.ma.us>
|
|
;; Maintainer: Magnus Henoch <magnus.henoch@gmail.com>
|
|
|
|
;; $Id$
|
|
;; The path above is on the Perforce server public.perforce.com:1666.
|
|
;; You can get this file using a P4 client talking to that depot, or
|
|
;; from the URL
|
|
;; http://public.perforce.com/guest/magnus_henoch/vc-p4/vc-p4.el.
|
|
|
|
;; This version is intended for Emacs 23 and later; for Emacs 22 or
|
|
;; earlier, you might want the original version:
|
|
;; http://public.perforce.com/guest/jonathan_kamens/vc-p4/vc-p4.el.
|
|
|
|
;; 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 23 and any
|
|
;; other Emacs variant which uses the VC mode included in Emacs 23.
|
|
;;
|
|
;; 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
|
|
;; much 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-and-compile
|
|
(if (not (string-match "XEmacs" emacs-version))
|
|
(require 'vc-annotate))
|
|
(require 'vc-hooks)
|
|
(require 'vc)
|
|
(require 'ediff))
|
|
;; FIXME: setq ediff-quit-hook maybe should be add-hook...
|
|
|
|
(eval-and-compile
|
|
(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)
|
|
|
|
(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 nil
|
|
"*Specifies the name of a command to call to annotate Perforce files.
|
|
If nil, then `vc-p4-annotate-command-internal' will be used.
|
|
I recommend //guest/jonathan_kamens/p4pr.perl in the Perforce
|
|
repository public.perforce.com:1666. Note that you need a version of
|
|
this script which accept `--after=date', if you want to be able to
|
|
specify a starting date when you run C-u C-x v g."
|
|
:type 'string
|
|
:group 'vc)
|
|
|
|
(defun vc-p4-revision-granularity ()
|
|
"Return file.
|
|
Perforce has per-file revisions."
|
|
'file)
|
|
|
|
(defun vc-p4-create-repo ()
|
|
(error "create-repo not supported yet for P4"))
|
|
|
|
(defun vc-p4-registered (file)
|
|
"Return non-nil is FILE is handled by Perforce."
|
|
(if (p4-lowlevel-locate-p4)
|
|
(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))
|
|
(action (cdr (or (assoc "action" fstat)
|
|
(assoc "headAction" fstat)))))
|
|
(if (or (not fstat)
|
|
(string= action "delete"))
|
|
nil
|
|
;; This sets a bunch of VC properties
|
|
(vc-p4-state file fstat)
|
|
t)))))
|
|
|
|
(defun vc-p4-state (file &optional fstat-list force dont-compare-nonopened)
|
|
"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 DONT-COMPARE-NONOPENED is non-nil, don't
|
|
compare non-open files to the depot version."
|
|
(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 t))))
|
|
(if (null alist)
|
|
'unregistered
|
|
(let* (
|
|
(headRev (cdr (assoc "headRev" alist)))
|
|
(haveRev (cdr (assoc "haveRev" alist)))
|
|
(depotFile (cdr (assoc "depotFile" alist)))
|
|
(action (cdr (assoc "action" alist)))
|
|
(headAction (cdr (assoc "headAction" alist)))
|
|
(state
|
|
(cond
|
|
((string= action "delete")
|
|
'removed)
|
|
(action
|
|
(let ((opened (p4-lowlevel-opened file)))
|
|
(if (string-match " by \\([^@]+\\)@" opened)
|
|
(match-string 1 opened)
|
|
(if (equal headRev haveRev)
|
|
(if (string= action "add") 'added 'edited)
|
|
'needs-merge))))
|
|
((and (file-exists-p file)
|
|
(not dont-compare-nonopened)
|
|
(p4-lowlevel-diff-s file "e"))
|
|
'unlocked-changes)
|
|
((or
|
|
(equal headRev haveRev)
|
|
(and (null haveRev) (string= headAction "delete")))
|
|
'up-to-date)
|
|
(t
|
|
'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)))))
|
|
|
|
(defun vc-p4-dir-status (dir update-function)
|
|
"Find information for `vc-dir'."
|
|
;; XXX: this should be asynchronous.
|
|
(let ((lists (p4-lowlevel-fstat
|
|
(format "%s/..." (directory-file-name (expand-file-name dir)))
|
|
nil t)))
|
|
(when (stringp (caar lists))
|
|
(setq lists (list lists)))
|
|
(dolist (this-list lists)
|
|
(let* ((this-file (cdr (assoc "clientFile" this-list)))
|
|
(state (vc-p4-state this-file this-list t t)))
|
|
(unless (eq state 'up-to-date)
|
|
(funcall update-function
|
|
(list
|
|
(list (file-relative-name this-file dir) state))
|
|
t))))
|
|
(funcall update-function nil nil)))
|
|
|
|
(defun vc-p4-working-revision (file)
|
|
"Returns the Perforce version of FILE."
|
|
(vc-p4-state file)
|
|
(vc-file-getprop file 'vc-workfile-version))
|
|
|
|
(defun vc-p4-previous-revision (file rev)
|
|
(let ((newrev (1- (string-to-number rev))))
|
|
(when (< 0 newrev)
|
|
(number-to-string newrev))))
|
|
|
|
(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"))
|
|
(not (equal (vc-file-getprop file 'vc-p4-action) "delete"))
|
|
(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 (files &optional rev comment)
|
|
(if (and rev (not (string= rev "1")))
|
|
(error "Can't specify revision when registering Perforce file."))
|
|
(if (and comment (not (string= comment "")))
|
|
(error "Can't specify comment when registering Perforce file."))
|
|
;; In emacs-23 vc-register has a list of files as a parameter,
|
|
;; 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.
|
|
(let* ((file (if (listp files) (car files) files))
|
|
(fstat (p4-lowlevel-fstat file nil t))
|
|
(action (cdr (assoc "action" fstat))))
|
|
(if (string= action "delete")
|
|
(if (yes-or-no-p
|
|
"File already opened for delete; revert and edit it? ")
|
|
(progn
|
|
(if (yes-or-no-p "Preserve current contents? ")
|
|
(let ((tempfile (format "%s.vc-register~" file)))
|
|
(rename-file file tempfile)
|
|
(p4-lowlevel-revert file)
|
|
(delete-file file)
|
|
(rename-file tempfile file))
|
|
(p4-lowlevel-revert file))
|
|
(p4-lowlevel-edit file))
|
|
(error "File %s already opened for delete." file))
|
|
(p4-lowlevel-add file))))
|
|
|
|
(defun vc-p4-init-revision ()
|
|
"Returns `1', the default initial version for Perforce files."
|
|
"1")
|
|
|
|
(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-find-version (file rev buffer)
|
|
(p4-lowlevel-print file rev buffer t))
|
|
|
|
(defun vc-p4-checkin (files rev comment)
|
|
"Check FILES into Perforce. Error if REV is non-nil. Check in with
|
|
comment COMMENT."
|
|
(if rev
|
|
(error "Can't specify revision for Perforce checkin."))
|
|
(let* (;; XXX: default-directory? this should work for most (all?) cases
|
|
(default-directory (file-name-directory (car files)))
|
|
(change-buffer (p4-lowlevel-change))
|
|
(indent-tabs-mode 1)
|
|
insertion-start change-number)
|
|
(dolist (file files)
|
|
(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))
|
|
(dolist (file files)
|
|
(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
|
|
(dolist (file files)
|
|
(vc-p4-state file nil t)))))
|
|
|
|
;;; FIXME: this should not have a DESTFILE argument
|
|
(defun vc-p4-checkout (file &optional rev)
|
|
(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)))
|
|
((or (string= rev "")
|
|
(eq rev t))
|
|
(setq rev (vc-file-getprop file 'vc-latest-version))))
|
|
(if (not (string= rev (vc-file-getprop file 'vc-workfile-version)))
|
|
(p4-lowlevel-sync file rev))
|
|
(p4-lowlevel-edit file))
|
|
(vc-p4-state file nil t))
|
|
|
|
(defun vc-p4-revert (file contents-done)
|
|
"Revert FILE in Perforce. Ignores CONTENTS-DONE."
|
|
(let ((action (vc-file-getprop file 'vc-p4-action)))
|
|
(cond
|
|
((null action)
|
|
;; If Perforce doesn't believe that we edited the file, we have
|
|
;; to use sync instead of revert.
|
|
(p4-lowlevel-sync file (vc-workfile-version file) t))
|
|
(t
|
|
(p4-lowlevel-revert file)))
|
|
(if (string= action "add")
|
|
(vc-file-clearprops 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 (files &optional buffer shortlog revision limit)
|
|
"Print Perforce log for FILE into *vc* buffer."
|
|
;; `log-view-mode' needs to have the file name in order to function
|
|
;; correctly. "p4 logview" does not print it, so we insert it here by
|
|
;; hand.
|
|
|
|
;; `vc-do-command' creates the buffer, but we need it before running
|
|
;; the command.
|
|
(vc-setup-buffer buffer)
|
|
(let* ((inhibit-read-only t)
|
|
;; In emacs-23 vc-print-log has a list of files as a
|
|
;; parameter, 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.
|
|
(file (if (listp files) (car files) files))
|
|
(default-directory (file-name-directory file)))
|
|
(with-current-buffer
|
|
buffer
|
|
(p4-lowlevel-filelog file (current-buffer) (not shortlog) nil limit)
|
|
;; Insert the file name at the beginning.
|
|
(goto-char (point-min))
|
|
(insert "File: " (file-name-nondirectory file) "\n"))))
|
|
|
|
(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")))
|
|
|
|
(defvar log-view-message-re)
|
|
(defvar log-view-file-re)
|
|
(defvar log-view-font-lock-keywords)
|
|
|
|
(define-derived-mode vc-p4-log-view-mode log-view-mode "P4-Log-View"
|
|
(require 'add-log) ;; we need the faces add-log
|
|
(set (make-local-variable 'log-view-file-re) "^File:[ \t]+\\(.+\\)")
|
|
(set (make-local-variable 'log-view-message-re)
|
|
"^#\\([0-9]+\\) .*")
|
|
(set (make-local-variable 'log-view-font-lock-keywords)
|
|
(append `((,log-view-message-re . 'log-view-message-face)
|
|
(,log-view-file-re . 'log-view-file-face))
|
|
'(("^user:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
|
|
(1 'change-log-email))
|
|
;; Handle the case:
|
|
;; user: FirstName LastName <foo@bar>
|
|
("^user:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
|
|
(1 'change-log-name)
|
|
(2 'change-log-email))
|
|
("^date: \\(.+\\)" (1 'change-log-date))
|
|
("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))
|
|
|
|
(defun vc-p4-diff (file-or-files &optional rev1 rev2 buff _async)
|
|
"Do a Perforce diff."
|
|
(let* ((buffer (cond
|
|
((bufferp buff) buff)
|
|
((stringp buff) (get-buffer-create buff))
|
|
(t (get-buffer-create "*vc-diff*"))))
|
|
(files (if (atom file-or-files) (list file-or-files) file-or-files))
|
|
(inhibit-read-only t))
|
|
(cond
|
|
((and (null rev1) (null rev2))
|
|
(let (added modified deleted)
|
|
(dolist (file files)
|
|
(cond
|
|
((string= (vc-file-getprop file 'vc-p4-action) "add")
|
|
(push file added))
|
|
((string= (vc-file-getprop file 'vc-p4-action) "delete")
|
|
(push file deleted))
|
|
(t
|
|
(push file modified))))
|
|
(setq added (nreverse added)
|
|
modified (nreverse modified)
|
|
deleted (nreverse deleted))
|
|
|
|
;; For added and deleted files, Perforce can't give us what we
|
|
;; want (diff against /dev/null), so we do it ourselves.
|
|
(with-current-buffer buffer
|
|
(erase-buffer)
|
|
(dolist (file added)
|
|
(apply 'call-process
|
|
(append
|
|
(list diff-command
|
|
nil
|
|
buffer
|
|
nil)
|
|
(if (listp diff-switches)
|
|
diff-switches
|
|
(list diff-switches))
|
|
(list "/dev/null"
|
|
file))))
|
|
(dolist (file deleted)
|
|
(with-temp-buffer
|
|
(p4-lowlevel-print file nil (current-buffer) :quiet)
|
|
(goto-char (point-min))
|
|
(while (search-forward-regexp "^text: " nil t)
|
|
(replace-match "" nil nil))
|
|
(apply 'call-process-region
|
|
(point-min) (point-max)
|
|
diff-command
|
|
:delete
|
|
buffer
|
|
nil
|
|
(append
|
|
(list "-N"
|
|
;; Not sure this is the most useful labeling...
|
|
(concat "--label=" (vc-file-getprop file 'vc-p4-depot-file))
|
|
(concat "--label=" file))
|
|
(if (listp diff-switches)
|
|
diff-switches
|
|
(list diff-switches))
|
|
(list "-"
|
|
"/dev/null")))))
|
|
|
|
;; Now diff all the modified files in a single call to the server.
|
|
(when modified
|
|
(let (temp-buffer)
|
|
(unwind-protect
|
|
(progn
|
|
(setq temp-buffer (p4-lowlevel-diff modified))
|
|
(insert-buffer-substring temp-buffer))
|
|
(when (buffer-live-p temp-buffer)
|
|
(kill-buffer temp-buffer))))))))
|
|
|
|
(t
|
|
;; At this point things get complicated. Let's just make one
|
|
;; request per file and hope the server administrator doesn't
|
|
;; mind.
|
|
(with-current-buffer buffer
|
|
(let (temp-buffer)
|
|
(dolist (file files)
|
|
(setq temp-buffer
|
|
(cond
|
|
((and (not rev1) rev2)
|
|
(p4-lowlevel-diff2 file file
|
|
(vc-file-getprop file 'vc-workfile-version)
|
|
rev2))
|
|
((and rev1 rev2)
|
|
(p4-lowlevel-diff2 file file rev1 rev2))
|
|
((and rev1 (not rev2))
|
|
(p4-lowlevel-diff file rev1))))
|
|
(insert-buffer-substring temp-buffer)
|
|
(kill-buffer temp-buffer))))))
|
|
|
|
;; Emacs doesn't understand Perforce's file headers, so we add
|
|
;; them ourselves.
|
|
(with-current-buffer buffer
|
|
(goto-char (point-min))
|
|
(while (re-search-forward "^==== \\(.+#[0-9]+\\) - \\(.+\\) ====$" nil t)
|
|
(let ((depot-name (match-string 1))
|
|
(filename (match-string 2)))
|
|
(insert "\n--- " depot-name
|
|
"\n+++ " filename))))))
|
|
|
|
(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."
|
|
(if vc-p4-annotate-command
|
|
(let ((full-file (if version
|
|
(concat file
|
|
(p4-lowlevel-canonicalize-revision version))
|
|
file))
|
|
(starting-date (if current-prefix-arg
|
|
(read-string "Starting date: (default none) ")))
|
|
log-buffer times args)
|
|
(setq args (append (list buffer nil vc-p4-annotate-command nil)
|
|
(if starting-date
|
|
(list "--after" starting-date))
|
|
(list full-file)))
|
|
(apply 'vc-do-command args))
|
|
(vc-p4-annotate-command-internal file buffer version)))
|
|
|
|
;;; Adapted from p4.el
|
|
(defun vc-p4-read-output (buffer)
|
|
"Reads first line of BUFFER and returns it.
|
|
Read lines are deleted from buffer."
|
|
(save-excursion
|
|
(set-buffer buffer)
|
|
(goto-char (point-min))
|
|
(forward-line)
|
|
(let ((line (buffer-substring (point-min) (point))))
|
|
(if (string= line "")
|
|
nil
|
|
(delete-region (point-min) (point))
|
|
;; remove trailing newline
|
|
(if (equal (substring line (1- (length line)) (length line)) "\n")
|
|
(substring line 0 (1- (length line)))
|
|
line)))))
|
|
|
|
;;; Adapted from p4.el
|
|
(defun vc-p4-annotate-command-internal (file buffer &optional version)
|
|
"Execute \"hg annotate\" on FILE, inserting the contents in BUFFER.
|
|
Optional arg VERSION is a version to annotate from."
|
|
;; XXX maybe not needed, but just in case.
|
|
(vc-setup-buffer buffer)
|
|
;; (with-current-buffer buffer
|
|
(let ((file-name file)
|
|
(file-spec file)
|
|
(blame-branch-regex
|
|
"^\\.\\.\\. \\.\\.\\. branch from \\(//[^#]*\\)#")
|
|
(blame-change-regex
|
|
(concat "^\\.\\.\\. #" "\\([0-9]+\\)" ;; revision
|
|
"\\s-+change\\s-+" "\\([0-9]+\\)" ;; change
|
|
"\\s-+" "\\([^ \t]+\\)" ;; type
|
|
"\\s-+on\\s-+" "\\([^ \t]+\\)" ;; date
|
|
"\\s-+by\\s-+" "\\([^ \t]+\\)" ;; author
|
|
"@"))
|
|
head-name ;; file spec of the head revision for this blame assignment
|
|
branch-p ;; have we tracked into a branch?
|
|
cur-file ;; file name of the current branch during blame assignment
|
|
change ch-alist fullname head-rev headseen)
|
|
|
|
;; we asked for blame constrained by a change number
|
|
(if (string-match "\\(.*\\)@\\([0-9]+\\)" file-spec)
|
|
(progn
|
|
(setq file-name (match-string 1 file-spec))
|
|
(setq change (string-to-number (match-string 2 file-spec)))))
|
|
|
|
;; we asked for blame constrained by a revision
|
|
(if (string-match "\\(.*\\)#\\([0-9]+\\)" file-spec)
|
|
(progn
|
|
(setq file-name (match-string 1 file-spec))
|
|
(setq head-rev (string-to-number (match-string 2 file-spec)))))
|
|
|
|
;; make sure the filespec is unambiguous
|
|
;;(p4-exec-p4 buffer (list "files" file-name) t)
|
|
(with-temp-buffer
|
|
(vc-p4-command (current-buffer) nil nil "files" file-name)
|
|
(save-excursion
|
|
;; (set-buffer buffer)
|
|
(if (> (count-lines (point-min) (point-max)) 1)
|
|
(error "File pattern maps to more than one file."))))
|
|
;; get the file change history:
|
|
;;(p4-exec-p4 buffer (list "filelog" "-i" file-spec) t)
|
|
(with-temp-buffer
|
|
(vc-p4-command (current-buffer) 0 nil "filelog" "-i" file-spec)
|
|
(setq fullname (vc-p4-read-output (current-buffer))
|
|
cur-file fullname
|
|
head-name fullname)
|
|
|
|
;; parse the history:
|
|
(save-excursion
|
|
;; (set-buffer buffer)
|
|
(goto-char (point-min))
|
|
(while (< (point) (point-max))
|
|
|
|
;; record the current file name (and the head file name,
|
|
;; if we have not yet seen one):
|
|
(if (looking-at "^\\(//.*\\)$")
|
|
(setq cur-file (match-string 1)))
|
|
|
|
;; a non-branch change:
|
|
(if (looking-at blame-change-regex)
|
|
(let ((rev (string-to-number (match-string 1)))
|
|
(ch (string-to-number (match-string 2)))
|
|
(op (match-string 3))
|
|
(date (match-string 4))
|
|
(author (match-string 5)))
|
|
(cond
|
|
;; after the change constraint, OR
|
|
;; after the revision constraint _for this file_
|
|
;; [remember, branches complicate this]:
|
|
((or (and change (< change ch))
|
|
(and head-rev (< head-rev rev)
|
|
(string= head-name cur-file))) nil)
|
|
|
|
;; file has been deleted, can't assign blame:
|
|
((string= op "delete")
|
|
(if (not headseen) (goto-char (point-max))))
|
|
|
|
;; OK, we actually want to look at this one:
|
|
(t
|
|
(setq ch-alist
|
|
(cons
|
|
(cons ch (list rev date author cur-file)) ch-alist))
|
|
(if (not head-rev) (setq head-rev rev))
|
|
(setq headseen t))))
|
|
|
|
;; not if we have entered a branch (this used to be used, isn't
|
|
;; right now - maybe again later:
|
|
(if (and headseen (looking-at blame-branch-regex))
|
|
(setq branch-p t)))
|
|
(forward-line))))
|
|
|
|
(if (< (length ch-alist) 1)
|
|
(error "Head revision not available"))
|
|
|
|
(let ((base-ch (int-to-string (caar ch-alist)))
|
|
(ch-buffer (get-buffer-create " *p4-ch-buf*"))
|
|
(tmp-alst (copy-alist ch-alist)))
|
|
;; (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))
|
|
(save-excursion
|
|
(set-buffer ch-buffer)
|
|
(goto-char (point-min))
|
|
(while (re-search-forward ".*\n" nil t)
|
|
(replace-match (concat base-ch "\n"))))
|
|
(while (> (length tmp-alst) 1)
|
|
(let ((ch-1 (car (car tmp-alst)))
|
|
(ch-2 (car (cadr tmp-alst)))
|
|
(file1 (nth 3 (cdr (car tmp-alst))))
|
|
(file2 (nth 3 (cdr (cadr tmp-alst))))
|
|
(blame-revision-regex
|
|
(concat "^\\([0-9]+\\),?"
|
|
"\\([0-9]*\\)"
|
|
"\\([acd]\\)"
|
|
"\\([0-9]+\\),?"
|
|
"\\([0-9]*\\)"))
|
|
ins-string)
|
|
(setq ins-string (format "%d\n" ch-2))
|
|
;; (p4-exec-p4 buffer (list "diff2"
|
|
;; (format "%s@%d" file1 ch-1)
|
|
;; (format "%s@%d" file2 ch-2)) t)
|
|
(with-temp-buffer
|
|
(vc-p4-command (current-buffer) nil nil
|
|
"diff2" (format "%s@%d" file1 ch-1)
|
|
(format "%s@%d" file2 ch-2))
|
|
(save-excursion
|
|
;;(set-buffer buffer)
|
|
(goto-char (point-max))
|
|
(while (re-search-backward blame-revision-regex nil t)
|
|
(let ((la (string-to-number (match-string 1)))
|
|
(lb (string-to-number (match-string 2)))
|
|
(op (match-string 3))
|
|
(ra (string-to-number (match-string 4)))
|
|
(rb (string-to-number (match-string 5))))
|
|
(if (= lb 0)
|
|
(setq lb la))
|
|
(if (= rb 0)
|
|
(setq rb ra))
|
|
(cond ((string= op "a")
|
|
(setq la (1+ la)))
|
|
((string= op "d")
|
|
(setq ra (1+ ra))))
|
|
(save-excursion
|
|
(set-buffer ch-buffer)
|
|
(goto-line la)
|
|
(let ((beg (point)))
|
|
(forward-line (1+ (- lb la)))
|
|
(delete-region beg (point)))
|
|
(while (<= ra rb)
|
|
(insert ins-string)
|
|
(setq ra (1+ ra))))))))
|
|
(setq tmp-alst (cdr tmp-alst))))
|
|
;; (p4-noinput-buffer-action "print" nil t
|
|
;; (list (format "%s#%d" fullname head-rev))
|
|
;; t)
|
|
(vc-p4-command buffer nil nil
|
|
"print" (format "%s#%d" fullname head-rev))
|
|
(let (line cnum (old-cnum 0) change-data
|
|
(blame-index-regex
|
|
(concat " *\\([0-9]+/[0-9]+/[0-9]+\\)" ;; date
|
|
"\\s-+\\([^ \t]*\\)" ;; author
|
|
" *\\([0-9]+\\)" ;; change
|
|
" *\\([0-9]+\\)" ;; revision
|
|
" "))
|
|
xth-rev xth-date xth-auth xth-file)
|
|
(save-excursion
|
|
(set-buffer buffer)
|
|
(goto-line 2)
|
|
(move-to-column 0)
|
|
(insert (format "%10s %7s %6s %4s\n" "Date" "Author" "Change" "Rev"))
|
|
(while (setq line (vc-p4-read-output ch-buffer))
|
|
(setq cnum (string-to-number line))
|
|
(if (and nil (= cnum old-cnum))
|
|
(insert (format "%29s " ""))
|
|
|
|
;; extract the change data from our alist: remember,
|
|
;; `eq' works for integers so we can use assq here:
|
|
(setq change-data (cdr (assq cnum ch-alist))
|
|
xth-rev (nth 0 change-data)
|
|
xth-date (nth 1 change-data)
|
|
xth-auth (nth 2 change-data)
|
|
xth-file (nth 3 change-data))
|
|
|
|
(insert
|
|
(format "%10s %7s %6d %4d " xth-date xth-auth cnum xth-rev))
|
|
(move-to-column 0)
|
|
(if (looking-at blame-index-regex)
|
|
(let ((nth-cnum (match-string 3))
|
|
(nth-revn (match-string 4))
|
|
(nth-user (match-string 2)))
|
|
;; truncate the user name:
|
|
(let ((start (+ (match-beginning 2) 7))
|
|
(end (match-end 2)))
|
|
(if (> end start)
|
|
(delete-region start end))))))
|
|
(setq old-cnum cnum)
|
|
(forward-line))))
|
|
|
|
(kill-buffer ch-buffer))))
|
|
|
|
(defconst vc-p4-annotate-re
|
|
(concat "^\\([[:digit:]/]+\\)[[:space:]]*[[:digit:]]+[[:space:]]+"
|
|
"[^[:space:]]+[[:space:]]+\\([[:digit:]]+\\)"
|
|
"[[:space:]]+\\([[:digit:]]+\\) "))
|
|
|
|
(defun vc-p4-annotate-time ()
|
|
"Returns the time of the next Perforce annotation at or after point,
|
|
as a floating point fractional number of days.
|
|
Moves the point to the end of the annotation."
|
|
(when (and (looking-at vc-p4-annotate-re) (fboundp 'vc-annotate-convert-time))
|
|
(goto-char (match-end 0))
|
|
(let ((timestr (match-string-no-properties 1)))
|
|
(string-match "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)" timestr)
|
|
(vc-annotate-convert-time
|
|
(encode-time 0 0 0
|
|
(string-to-number (match-string 3 timestr))
|
|
(string-to-number (match-string 2 timestr))
|
|
(string-to-number (match-string 1 timestr)))))))
|
|
|
|
(defun vc-p4-annotate-extract-revision-at-line ()
|
|
(save-excursion
|
|
(beginning-of-line)
|
|
(if (looking-at vc-p4-annotate-re) (match-string-no-properties 3))))
|
|
|
|
(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 (expand-file-name (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)))
|
|
|
|
(defun vc-p4-command (buffer okstatus file &rest flags)
|
|
"A wrapper around `vc-do-command' for use in vc-p4.el.
|
|
The difference to vc-do-command is that this function always invokes `p4'."
|
|
(apply 'vc-do-command buffer okstatus "p4" file flags))
|
|
|
|
(provide 'vc-p4)
|