;;; 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: //guest/Ben_Key/vc-p4/vc-p4.el#2 $ ;; 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-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 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." (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) "Do a Perforce diff." (let* ((buffer (or (bufferp buff) (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)
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#2 | 12013 | Ben_Key |
Various modifications to vc-p4 that I have been using for years. Unfortunately I did not document the changes as I made them. I have been able to determine the purpose of most of the changes by code inspection but there are a few changes for which I have not been able to determine a purpose. * Modifications to support XEmacs. * Added the p4-lowlevel-locate-p4 function. This function is used to locate the p4 executable on the exec-path. It is used by the vc-p4-registered function to avoid an error on systems on which the Perforce client is not installed. This is useful if the same .emacs file is used on multiple systems, some of which do not have the Perforce client installed. * Modified the p4-lowlevel-successful-alist-p function so that a command that returns the message "file(s) up-to-date" does not trigger an error. As part of this change I added the p4-lowlevel-ignore-error-list defcustom and the p4-lowlevel-should-ignore-error function. * Modified the vc-p4-registered function so that it uses the p4-lowlevel-locate-p4 function to verify that the Perforce client is installed. |
||
#1 | 12012 | Ben_Key |
Populate -o //guest/magnus_henoch/vc-p4/... //guest/Ben_Key/vc-p4/.... |
||
//guest/magnus_henoch/vc-p4/vc-p4.el | |||||
#27 | 7742 | Magnus Henoch | * vc-p4.el (vc-p4-state): Mark new files as added. | ||
#26 | 7741 | Magnus Henoch | * vc-p4.el (vc-p4-state): Don't compare non-existent files. | ||
#25 | 7740 | Magnus Henoch | * vc-p4.el (vc-p4-workfile-unchanged-p): Return nil for files marked for deletion. | ||
#24 | 7739 | Magnus Henoch | * vc-p4.el (vc-p4-diff): Handle deleted files. | ||
#23 | 7738 | Magnus Henoch | * vc-p4.el (vc-p4-state): Mark file as `removed' if action is "delete". | ||
#22 | 7546 | Magnus Henoch |
* vc-p4.el (vc-p4-previous-revision): New function, shamelessly copied from vc-svn. |
||
#21 | 7545 | Magnus Henoch |
* vc-p4.el (vc-p4-print-log): Accept optional argument revision, as required by Emacs 23.1.91. |
||
#20 | 7487 | Magnus Henoch |
* vc-p4.el (vc-p4-print-log): Accept optional arguments shortlog and limit, as required by Emacs 23.1.50. * p4-lowlevel.el (p4-lowlevel-filelog): Accept limit argument. |
||
#19 | 7486 | Magnus Henoch | * vc-p4.el (vc-p4-revert): Fix revert of unopened files. | ||
#18 | 7485 | Magnus Henoch | * vc-p4.el (vc-p4-diff): Fix Perforce file headers. | ||
#17 | 7484 | Magnus Henoch |
* vc-p4.el (vc-p4-diff): Support lists of files. Perform only a single request to the server in the simplest case (diff edited file to synced version). * p4-lowlevel.el (p4-lowlevel-command-into-buffer): Don't reorder info and text lines. (p4-lowlevel-diff): Support lists of files as well as a single file. |
||
#16 | 7377 | Magnus Henoch |
* vc-p4.el (vc-p4-state): Avoid error when saving non-Perforce file inside Perforce working directory. Still gives incorrect 'up-to-date' status in vc-dir sometimes. |
||
#15 | 7362 | Magnus Henoch |
* vc-p4.el (vc-p4-state): Display files present neither on client nor in depot head as `up-to-date'. |
||
#14 | 7361 | Magnus Henoch | * vc-p4.el (vc-p4-state): Change `if' mess to `cond'. | ||
#13 | 7360 | Magnus Henoch | * vc-p4.el (vc-p4-dir-status): Don't list up-to-date files. | ||
#12 | 7330 | Magnus Henoch | * vc-p4.el: Note that Emacs 23 is required. | ||
#11 | 7270 | Magnus Henoch |
(vc-p4-working-revision): Renamed from `vc-p4-workfile-version', to avoid deprecation message on commit. |
||
#10 | 7269 | Magnus Henoch | (vc-p4-checkin): Multiple files commit. | ||
#9 | 7268 | Magnus Henoch | (vc-p4-init-revision): Renamed from `vc-p4-init-version'. | ||
#8 | 7239 | Magnus Henoch | Remove obsolete redefinitions. | ||
#7 | 7238 | Magnus Henoch | * vc-p4.el (vc-p4-annotate-command-internal): s/string-to-int/string-to-number/ | ||
#6 | 7237 | Magnus Henoch | * vc-p4.el (vc-p4-dir-state): Remove unused function. | ||
#5 | 7236 | Magnus Henoch |
* vc-p4.el (vc-p4-dir-status): Handle subdirectories. Use information from vc-p4-state. (vc-p4-state): New argument: dont-compare-nonopened. |
||
#4 | 7232 | Magnus Henoch | (vc-p4-dir-status): Initial implementation. | ||
#3 | 7231 | Magnus Henoch |
Update copyright notices. Update URL; include URL of previous version. |
||
#2 | 7217 | Magnus Henoch |
* vc-p4.el (vc-p4-diff): Reorder let* variables. Don't use `buffer-file-name'. |
||
#1 | 7216 | Magnus Henoch | Branched vc-p4 for work on Emacs 23 compatibility. | ||
//guest/jonathan_kamens/vc-p4/vc-p4.el | |||||
#19 | 5999 | Jonathan Kamens |
Changes from Dan Nicolaescu: For vc-p4.el: - delete a few more vc functions that are identical in emacs - delete now unused vc-p4-change-times - make vc-p4-annotate-command default to the internal elisp code - delete vc-p4-state-heuristic, it's the same as the default - new function vc-p4-find-version - make a few functions cope with emacs-23 (not released yet), that changes the first argument from FILE to FILE_LIST - add an internal implementation for vc-annotate, simplify the annotate code For p4-lowlevel.el: - fail graciously when offline and trying to access a file that is under perforce |
||
#18 | 5991 | Jonathan Kamens |
Patch from Dan Nicolaescu <dann@ics.uci.edu>: Improve support for vc-annotate and log-view and make sure that they are interoperable. |
||
#17 | 5990 | Jonathan Kamens |
Customized vc-mode-line is no longer necessary, since the version that ships with GNU Emacs is now fixed. |
||
#16 | 5989 | Jonathan Kamens |
The customized version of vc-register is no longer necessary, because the code for calling the backend init-version function has been incorporated into GNU Emacs's standard vc-register function. |
||
#15 | 5986 | Jonathan Kamens | Minor bug fixes from Dan Nicolaescu <dann@ics.uci.edu>. | ||
#14 | 2215 | Jonathan Kamens |
Fix a bug in the logic for determining whether to use smerge-ediff or backend-specific conflict resolution. |
||
#13 | 2214 | Jonathan Kamens |
Changed vc-print-log slightly to conform to current version of vc.el in Emacs source tree. |
||
#12 | 1328 | Jonathan Kamens |
(vc-p4-find-p4config): Convert the directory in which we're searching to an absolute path by calling expand-file-name on it, because file-name-directory doesn't do what we expect for relative paths ((file-name-directory "..") returns nil, when we're expecting it to eventually return "/"). |
||
#11 | 1266 | Jonathan Kamens |
(vc-p4-registered): Don't consider a file registered if its current action or head action is "delete". (vc-p4-register): If someone tries to register a file which is currently open for delete, offer them the choice of reverting and editing the file, possibly preserving its contents. |
||
#10 | 1264 | Jonathan Kamens | Need to set default directory before trying to print the log. | ||
#9 | 1253 | Jonathan Kamens |
Add the function vc-p4-init-version, which always returns "1". Add a fixed version of vc-register which uses vc-p4-init-version. Add a fixed version of vc-mode-line which sets vc-mode to nil if a file isn't under version control, so that the VC information is removed from the mode line of a reverted file. Fixv vc-p4-register so that it doesn't complain if the specified revision is "1" or if the specified comment is an empty string. Fix vc-p4-revert so that it does the right thing if the file being reverted was added but not yet submitted (i.e., it isn't yet actually in the repository). Fix vc-p4-diff so that it does the right thing with a newly added file (i.e., diffs the file against /dev/null). |
||
#8 | 1233 | Jonathan Kamens | Update the coument documenting vc-p4-annotate-command. | ||
#7 | 1225 | Jonathan Kamens |
When doing an annotation, if the user called the annotate function with a prefix argument, then prompt for the starting date for the annotation. Note that this requires a version of p4pr.perl that supports the --after option. |
||
#6 | 1223 | Jonathan Kamens |
Compatibility with the current version of vc.el in CVS at :pserver:anoncvs@subversions.gnu.org:/cvsroot/emacs. |
||
#5 | 1218 | Jonathan Kamens | Set ediff-default-variant even when doing merges with an ancestor. | ||
#4 | 1216 | Jonathan Kamens |
Fix a parenthesization error in the code for repairing some vc.el functions. |
||
#3 | 1215 | Jonathan Kamens | Fix a minor working error in a comment. | ||
#2 | 1214 | Jonathan Kamens |
Add comments telling people where these files can be retrieved from. |
||
#1 | 1213 | Jonathan Kamens | Initial version of Emacs 21 VC support for Perforce. |