1064 lines
43 KiB
EmacsLisp
1064 lines
43 KiB
EmacsLisp
;;; vc-p4.el --- Integrate Perforce support into VC mode in Emacs 21 -*- lexical-binding: t; -*-
|
||
|
||
;; 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:
|
||
|
||
(require 'log-edit)
|
||
(require 'vc-dir)
|
||
|
||
(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
|
||
"Flag indicating the ‘P4CONFIG’ environment variable is required.
|
||
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 dial-up 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 \\[vc-annotate] with
|
||
a prefix argument."
|
||
:type 'string
|
||
:group 'vc)
|
||
|
||
(defun vc-p4-revision-granularity ()
|
||
"Return file.
|
||
Perforce has per-file revisions."
|
||
'file)
|
||
|
||
(defun vc-p4-create-repo ()
|
||
"This function is not supported."
|
||
(error "The create-repo function isn’t 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 :noerror 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)
|
||
"Return 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, re-fetch 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 :noerror 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-update))))
|
||
(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-files (dir _files update-function)
|
||
"Find status information for files in the directory DIR.
|
||
_FILES is ignored. The UPDATE-FUNCTION is used to process the
|
||
results of this function."
|
||
;; XXX: this should be asynchronous.
|
||
(let* ((lists (p4-lowlevel-fstat
|
||
(format "%s/..." (directory-file-name (expand-file-name dir)))
|
||
:noerror t)))
|
||
(when (stringp (caar lists))
|
||
(setq lists (list lists)))
|
||
(dolist (this-list lists)
|
||
(let* ((this-file (cdr (assoc "clientFile" this-list)))
|
||
(type (cdr (assoc "headType" 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 type))
|
||
t))))
|
||
(funcall update-function nil nil)))
|
||
|
||
(defun vc-p4-working-revision (file)
|
||
"Return the Perforce version of FILE."
|
||
(vc-p4-state file)
|
||
(vc-file-getprop file 'vc-workfile-version))
|
||
|
||
(defun vc-p4-previous-revision (_file rev)
|
||
"Return the previous revision before REV.
|
||
_FILE is ignored."
|
||
(let ((newrev (1- (string-to-number rev))))
|
||
(when (< 0 newrev)
|
||
(number-to-string newrev))))
|
||
|
||
(defun vc-p4-latest-on-branch-p (file)
|
||
"Return 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)
|
||
"Return the checkout model for Perforce (`announce').
|
||
Perforce only has one checkout model for all files, so _FILE is
|
||
ignored."
|
||
'announce)
|
||
|
||
(defun vc-p4-workfile-unchanged-p (file)
|
||
"Return 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-update)
|
||
(p4-lowlevel-diff-s file "r")))))
|
||
|
||
(defun vc-p4-mode-line-string (file)
|
||
"Return string for placement into the mode-line 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-working-revision file)))
|
||
(if (or (not rev) (string= rev "0"))
|
||
(setq rev "@@"))
|
||
(cond ((or (eq state 'up-to-date)
|
||
(eq state 'needs-update))
|
||
(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-update and 'needs-merge.
|
||
(concat "P4:" rev)))))
|
||
|
||
(defun vc-p4-register (files &optional rev comment)
|
||
"Register FILES with Perforce.
|
||
REV can only be 1, Perforce doesn’t support registering at any
|
||
other revision. COMMENT can only be nil or the empty string since
|
||
Perforce doesn’t support adding a comment to registering a file."
|
||
(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 :noerror 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 ()
|
||
"Return `1', the default initial version for Perforce files."
|
||
"1")
|
||
|
||
(defun vc-p4-responsible-p (file)
|
||
"Return non-nil if FILE is administered by Perforce.
|
||
FILE can point to either a file or a directory."
|
||
(if (and vc-p4-require-p4config
|
||
(getenv "P4CONFIG")
|
||
(not (vc-p4-find-p4config file)))
|
||
nil
|
||
(or (p4-lowlevel-fstat file :noerror t)
|
||
(vc-p4-is-in-client (if (file-directory-p file)
|
||
(file-name-as-directory file)
|
||
file)))))
|
||
|
||
(defun vc-p4-find-revision (file rev buffer)
|
||
"Get the contents of FILE at revision REV and put it into BUFFER."
|
||
(p4-lowlevel-print file
|
||
:rev rev
|
||
:output-format buffer
|
||
:quiet t))
|
||
|
||
(defun vc-p4-checkin (files comment &optional rev)
|
||
"Check FILES into Perforce.
|
||
Check in with comment COMMENT. Error if REV is non-nil."
|
||
(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)))
|
||
(with-current-buffer change-buffer
|
||
(goto-char (point-min))
|
||
(re-search-forward "^Description:\\s-*\n")
|
||
(kill-line 1)
|
||
(setq insertion-start (point))
|
||
(insert (car (log-edit-extract-headers nil comment)) "\n")
|
||
(indent-rigidly insertion-start (point) tab-width)
|
||
(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
|
||
:buffer (current-buffer)
|
||
:op t))
|
||
(p4-lowlevel-change
|
||
:buffer (current-buffer)
|
||
:op change-number)
|
||
(p4-lowlevel-submit (current-buffer))
|
||
; Update its properties
|
||
(dolist (file files)
|
||
(vc-p4-state file nil t)))))
|
||
|
||
(defun vc-p4-checkout (file &optional rev)
|
||
"Checkout FILE from Perforce, optionally at revision REV."
|
||
(let ((default-directory (file-name-directory file)))
|
||
;; 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 rev))
|
||
(p4-lowlevel-edit file))
|
||
(vc-p4-state file nil t))
|
||
|
||
(defun vc-p4-revert (file _contents-done)
|
||
"Revert FILE in Perforce.
|
||
_CONTENTS-DONE is ignored."
|
||
(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
|
||
:rev (vc-working-revision file)
|
||
:force 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 together two revisions of FILE.
|
||
REV1 and REV2 are the revisions to merge together."
|
||
(p4-lowlevel-integrate file file
|
||
:rev1 rev1
|
||
:rev2 rev2
|
||
:force 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)
|
||
"Get the latest version of FILE from Perforce."
|
||
(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 ()
|
||
"Resolve a file by selecting your version."
|
||
(vc-p4-select-conflict-text (current-buffer) 3))
|
||
|
||
(defun vc-p4-resolve-select-theirs ()
|
||
"Resolve a file by selecting their version."
|
||
(vc-p4-select-conflict-text (current-buffer) 2))
|
||
|
||
(defun vc-p4-resolve-select-original ()
|
||
"Resolve a file by selecting the original version."
|
||
(vc-p4-select-conflict-text (current-buffer) 1))
|
||
|
||
(defun vc-p4-steal-lock (file &optional version)
|
||
"Steal Perforce lock on FILE.
|
||
VERSION can only be the current version used in the workspace,
|
||
otherwise this function will raise an error."
|
||
(if (and version (not (equal version (vc-working-revision 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 FILES into BUFFER.
|
||
If SHORTLOG is non-nil print a short version of the log. _REVISION
|
||
is ignored. If LIMIT is non-nil only print that many log messages."
|
||
;; `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
|
||
:buffer (current-buffer)
|
||
:long (not shortlog)
|
||
:limit 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 log in the current buffer.
|
||
_FILE is ignored."
|
||
(goto-char (point-min))
|
||
(delete-non-matching-lines "^\t"))
|
||
|
||
(defun vc-p4-update-changelog (&optional files)
|
||
"Create ChangeLog entries for the files under ‘default-directory’.
|
||
Limit it to FILES if it’s non-nil"
|
||
(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
|
||
:rev1 start-rev
|
||
:rev2 end-rev
|
||
:l-flag t
|
||
:s-val "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 of FILE-OR-FILES.
|
||
If REV1 and REV2 are non-nil display the diff of the two
|
||
revisions. If BUFF is non-nil output the diff into it, or use the
|
||
*vc-diff* buffer otherwise. _async is ignored."
|
||
(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
|
||
:output-format (current-buffer)
|
||
:quiet t)
|
||
(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
|
||
:rev1 (vc-file-getprop file 'vc-workfile-version)
|
||
:rev2 rev2))
|
||
((and rev1 rev2)
|
||
(p4-lowlevel-diff2 file file
|
||
:rev1 rev1
|
||
:rev2 rev2))
|
||
((and rev1 (not rev2))
|
||
(p4-lowlevel-diff file :rev 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) ")))
|
||
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)
|
||
"Read the first line of BUFFER and return it.
|
||
Read lines are deleted from buffer."
|
||
(with-current-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 \"p4 annotate\" on FILE, inserting the contents in BUFFER.
|
||
_VERSION is ignored."
|
||
;; XXX maybe not needed, but just in case.
|
||
(vc-setup-buffer buffer)
|
||
;; (with-current-buffer buffer
|
||
(let ((file-name file)
|
||
(file-spec file)
|
||
(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
|
||
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)))))
|
||
(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))
|
||
(with-current-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
|
||
(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))))
|
||
(with-current-buffer ch-buffer
|
||
(goto-char (point-min))
|
||
(forward-line (1- 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)
|
||
(with-current-buffer buffer
|
||
(goto-char (point-min))
|
||
(forward-line 1)
|
||
(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))
|
||
|
||
(insert
|
||
(format "%10s %7s %6d %4d " xth-date xth-auth cnum xth-rev))
|
||
(move-to-column 0)
|
||
(if (looking-at blame-index-regex)
|
||
(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 ()
|
||
"Return the time of the next Perforce annotation at or after point.
|
||
The value is returned 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 ()
|
||
"Get the annotated revision on the current 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 prior to REV.
|
||
_FILE is ignored."
|
||
(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 non-nil if FILE is inside the p4 client hierarchy."
|
||
(let* ((default-directory (file-name-directory file))
|
||
(info (p4-lowlevel-info))
|
||
(root (alist-get "Client root" info nil nil #'string=))
|
||
(cwd (alist-get "Current directory" info nil nil #'string=)))
|
||
(string-prefix-p root cwd)))
|
||
|
||
(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
|
||
sub-block 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 sub-block in each conflict block."
|
||
(let (block-list block-start block-end subcount replacement)
|
||
(with-current-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’. The arguments BUFFER, OKSTATUS, FILE, and FLAGS are
|
||
all passed directly to ‘vc-do-command’, so check the
|
||
documentation for that command for their meanings."
|
||
(apply 'vc-do-command buffer okstatus "p4" file flags))
|
||
|
||
(defun vc-p4-delete-file (file)
|
||
"Tell perforce to delete FILE from the repository."
|
||
(p4-lowlevel-delete file))
|
||
|
||
(defun vc-p4-switch-client (client)
|
||
"Switch to CLIENT as the current client used for all operations."
|
||
(interactive
|
||
(list (completing-read "Client: " (p4-lowlevel-local-clients))))
|
||
(p4-lowlevel-command-or-error `("set" ,(format "P4CLIENT=%s" client))))
|
||
|
||
(defun vc-p4-login (password)
|
||
"Call the p4 login command user PASSWORD."
|
||
(interactive (list (read-passwd "P4 Password: ")))
|
||
(p4-lowlevel-login :password password))
|
||
|
||
(defun vc-p4-logged-in-p ()
|
||
"Check if there is an active session for Perforce."
|
||
(p4-lowlevel-login :status t))
|
||
|
||
(defun vc-p4-dir-extra-headers (dir)
|
||
"Get extra Perforce-specific vc-dir headers related to DIR."
|
||
(let* ((default-directory dir)
|
||
(extra-info (p4-lowlevel-info)))
|
||
(concat
|
||
(propertize "Client :" 'face 'font-lock-type-face)
|
||
" "
|
||
(propertize (alist-get "Client name" extra-info nil nil #'string=)
|
||
'face 'font-lock-variable-name-face)
|
||
"\n"
|
||
(propertize "Stream :" 'face 'font-lock-type-face)
|
||
" "
|
||
(propertize (alist-get "Client stream" extra-info nil nil #'string=)
|
||
'face 'font-lock-variable-name-face)
|
||
"\n"
|
||
(propertize "Root :" 'face 'font-lock-type-face)
|
||
" "
|
||
(propertize (alist-get "Client root" extra-info nil nil #'string=)
|
||
'face 'font-lock-variable-name-face)
|
||
"\n"
|
||
(propertize "Server :" 'face 'font-lock-type-face)
|
||
" "
|
||
(propertize (alist-get "Server address" extra-info nil nil #'string=)
|
||
'face 'font-lock-variable-name-face))))
|
||
|
||
(defun vc-p4-dir-printer (fileinfo)
|
||
"Call ‘vc-default-dir-printer’ and append the extra part of FILEINFO."
|
||
(vc-default-dir-printer 'P4 fileinfo)
|
||
(when-let ((extra (vc-dir-fileinfo->extra fileinfo)))
|
||
(insert " <" extra ">")))
|
||
|
||
(defun vc-p4-rename-file (old new)
|
||
"Rename OLD to NEW in Perforce."
|
||
(p4-lowlevel-rename old new))
|
||
|
||
(provide 'vc-p4)
|
||
;;; vc-p4.el ends here
|