;;; p4.el --- Perforce integration with emacs
;; Author: Paul Du Bois <dubois@geoworks.com>
;; Author: James Lefkowitz <jimmy@geoworks.com>
;; Author: Matt Armstrong <matta@geoworks.com>
;; Maintainer: dubois@infinite-machine.com
;; $Id: //depot/tools/lisp/p4.el#21 $
;;; Commentary:
;; Simple Usage:
;;
;; (require 'p4)
;; M-x customize-group p4
;;
;; (global-set-key "\C-x\C-q" 'p4-toggle-read-only)
;; (global-set-key [some-fkey] 'p4-opened)
;;
;; Major functions:
;;
;; p4-toggle-read-only like vc-toggle-read-only, but for p4
;;
;; Minor functions:
;;
;; p4-{add,edit,revert,diff,submit}
;; p4-reset
;; p4-sync-buffers
;;
;; Autoloaded packages:
;;
;; p4-opened
;; p4-update
;; p4-browse
;; p4-change-mode
;; p4-view-mode
;; p4-protect-mode
;;
;; Variables you shouldn't have to set:
;;
;; *p4-executable
;;; Code:
(require 'cl)
;;; -----------------------------------------------------------------
;;; User-level hooks
;;; -----------------------------------------------------------------
(defvar p4-before-execute-hook nil
"* This hook gets run before each invocation of p4.")
(defvar p4-diff-hook nil
"* Run after a p4-diff; current buffer is diff output.")
;; Obsolete variable
(defvar p4-use-geoworks-extensions nil
"Non nil means to assume p4.pl wrapper script is being used.
p4.pl provides some more user-friendly features.")
;;; ----------------------------------------------------------------------
;;; Customization shme
;;; ----------------------------------------------------------------------
(defgroup p4 nil
"Emacs integration with Perforce."
:group 'external
:load "p4-view"
:load "p4-opened"
:load "p4-protect"
:load "p4-menu"
:load "p4-job-mode"
)
(defgroup p4-faces nil
"Custom faces for Perforce integration."
:group 'p4)
(defcustom p4-executable
(if (eq window-system 'w32) "p4.exe" "p4")
"* Path to the Perforce client executable."
:group 'p4
:type 'file)
(defcustom p4-auto-sync-buffer nil
"* If non-nil, buffers will automatically be brought up to date after
a submit or revert. Otherwise, the user will be queried for each individual
buffer."
:group 'p4
:type 'boolean)
(defcustom p4-default-file-type "ktext"
"* Default file type to use for p4 add."
:group 'p4
:type '(choice (const "ktext")
(const "text")
(string :tag "Other")))
(defcustom p4-diff-type ()
"* Type of diff output."
:group 'p4
:type '(choice (const :tag "Default" ())
(const :tag "RCS" "-dn")
(const :tag "Contextual" "-dc")
(const :tag "Summary" "-ds")
(const :tag "Unified" "-du")))
(defcustom p4-quick-submit nil
"* If non-nil, `p4-submit' will prompt for a one-line description.
By default, it displays a full changelist form, allowing multi-line
descriptions for single-file submits."
:group 'p4
:type 'boolean)
(when window-system
(add-to-list 'facemenu-unlisted-faces 'p4-highlight-face)
(defface p4-highlight-face
'((((class color))
(:background "MidnightBlue" :foreground "white"))
(t (:bold t)))
"Face used for highlighting important text."
:group 'p4-faces)
)
;;; -----------------------------------------------------------------
;;; Internal and environment variables
;;; -----------------------------------------------------------------
(defvar p4-reset-hook nil
"Run before a p4-reset.
This would be a good place for subsidiary p4 packages to flush their
own caches.")
(defvar p4-debug nil)
(defvar p4-output-buffer-name " *P4 Output*")
(defvar p4-output-buffer p4-output-buffer-name)
(or (getenv "EDITOR") (setenv "EDITOR" "gnuclient"))
;; Append to regexp so emacsclient gets rid of our temp files
;; not needed for gnuclient.
(eval-when-compile (defvar server-temp-file-regexp))
(let ((p4-tmp-file-re "tmp\\..*"))
(if (and (boundp 'server-temp-file-regexp)
(not (string-match (regexp-quote p4-tmp-file-re)
server-temp-file-regexp)))
(setq server-temp-file-regexp
(concat p4-tmp-file-re
(if (string= server-temp-file-regexp "") "" "\\|")
server-temp-file-regexp))))
;;; -----------------------------------------------------------------
;;; Imported things from subsidiary files
;;; -----------------------------------------------------------------
;; Commands
(autoload 'mapcar* "cl")
(autoload 'p4-menu-mode "p4-menu" nil t)
(autoload 'p4-opened "p4-opened" "Show all opened files in current view" t)
(autoload 'p4-view-mode "p4-view")
(autoload 'p4-protect-mode "p4-protect")
(autoload 'p4-change "p4-change-mode"
"View and edit Perforce changelist CHANGE." t)
(autoload 'p4-change-noselect "p4-change-mode")
(autoload 'p4-cm-submit "p4-change-mode")
(autoload 'p4-browse-file-revisions "p4-browse" nil t)
(autoload 'p4-clients "p4-client-mode" nil t)
(autoload 'p4-merge-mode "p4-merge" nil t)
(autoload 'p4-changes "p4-changes-mode" nil t)
(autoload 'p4-jobs "p4-jobs"
"Show jobs matching a given filter")
(autoload 'p4-job "p4-job-mode"
"View and edit Perforce job JOB." t)
(autoload 'p4-job-noselect "p4-job-mode")
(autoload 'p4-job-mode "p4-job-mode")
;; Not so useful... remove?
(autoload 'p4-update "p4-update"
"See files that would be modified on a p4 update" t)
(autoload 'p4-update-current-buffer "p4-update"
"Merge latest depot changes into current buffer" t)
;;; ----------------------------------------------------------------------
;;; Macros
;;; ----------------------------------------------------------------------
;;; XXX: only works for Windows NT right now 'cuz I'm too lazy to
;;; look up what Windows95 sets system-type to.
(defmacro p4-if-win32 (true &rest false)
"Evaluate TRUE clause if we're running under Windows 95 or NT.
Otherwise do the FALSE clause. Should have the exact same
semantics/syntax as IF, if I wrote it correctly."
(` (if (eq system-type 'windows-nt)
(, true)
(,@ false))))
;;; -----------------------------------------------------------------
;;; Core utilities: client finding
;;; -----------------------------------------------------------------
;; Exports the function (p4-client). Everything else is internal.
;; Client to use for the current user command.
(defvar p4-temp-client nil)
(defvar p4-client-prompt-hist nil)
(defun p4-client (&optional prompt)
"Return a perforce client to use, or nil if one cannot be determined.
Optional PROMPT means don't bother searching for a client."
(if (null p4-temp-client)
(progn
(setq p4-temp-client (p4-client1 prompt))
(add-hook 'post-command-hook 'p4-clear-temp-client)))
p4-temp-client)
(defun p4-clear-temp-client ()
(setq p4-temp-client nil)
(remove-hook 'post-command-hook 'p4-clear-temp-client))
(defun p4-client1 (&optional prompt)
;; non-memoized version of p4-client
(or (and (null prompt) (p4-find-client))
(and (p4-warn-about-P4CLIENT) nil)
(read-string "Perforce client: "
(if p4-client-prompt-hist
(cons (car p4-client-prompt-hist) 0)
"")
'p4-client-prompt-hist)))
;; make sure the user doesn't have an old P4CLIENT file sitting around
(defun p4-warn-about-P4CLIENT ()
(let ((dir default-directory) prev-dir)
(if (catch 'dir-found
(while t
(if (file-regular-p (concat dir "P4CLIENT"))
(throw 'dir-found t))
(setq prev-dir dir
dir (file-name-directory (directory-file-name dir)))
(if (string= dir prev-dir) (throw 'dir-found nil))))
(progn
(message
"Warning: you have a P4CLIENT file which should be updated.")
(sit-for 3)))))
;; Alist that maps directory -> client"
(defvar p4-find-client-cache nil)
(add-hook 'p4-reset-hook (lambda () (setq p4-find-client-cache nil)))
(defun p4-find-client (&optional dir)
"Find the client associated with the current directory.
Optional argument DIR specifies a different directory."
(or dir (setq dir default-directory))
(setq dir (expand-file-name dir))
(catch 'client
;; Check cache first, exit if found
(p4-find-client-cache-lookup dir)
(let ((buf (get-buffer-create " *p4 info*")))
(unwind-protect
(save-excursion
(set-buffer buf)
(erase-buffer)
(setq default-directory dir)
(call-process p4-executable nil buf nil "info")
(goto-char (point-min))
(if (search-forward "Client unknown" nil t)
(throw 'client nil))
(goto-char (point-min))
(if (re-search-forward "Client name: \\(.*\\)" nil t)
(let ((client (match-string 1)) root)
(goto-char (point-min))
(re-search-forward "Client root: \\(.*\\)")
(setq root (match-string 1))
;; hack for win32 -- this makes root somewhat canonical
(p4-if-win32 (setq root (file-truename root)))
(p4-find-client-cache-store root client)
(throw 'client client))))
;(kill-buffer buf)
))))
(defun p4-find-client-cache-lookup (dir)
;; Look up DIR in cache. If successful, throw 'client with result
(setq dir (downcase dir))
(let ((dirlen (length dir)))
(mapcar (lambda (x)
(if (string-equal (car x)
(substring dir 0
(min dirlen (length (car x)))))
(throw 'client (cdr x))))
p4-find-client-cache)))
(defun p4-find-client-cache-store (dir client)
(add-to-list 'p4-find-client-cache (cons (downcase dir) client))
;; so more specific versions come before general ones
(sort p4-find-client-cache
(lambda (a b) (string-lessp (car b) (car a)))))
;;; -----------------------------------------------------------------
;;; Core utilities: Executing p4 and detecting errors
;;; -----------------------------------------------------------------
(defvar p4-exec-erase-buffer t
"If nil, p4-exec-p4{-fast} will not erase output buffer beforehand")
;; Warning: these functions depend on the default-directory of the calling
;; buffer! In general, make sure you don't call one of these from within a
;; (save-excursion (set-buffer foo) ... ) because that might mess up
;; default-directory
(defun p4-exec-p4-asynch (sentinel &rest args)
"Execute a p4 command asynchronously.
If non-nil, use SENTINEL as the process sentinel.
Returns the associated process object.
If you use -c to specify a client, it must be the first option."
(let (buf proc proc-name)
(run-hooks 'p4-before-execute-hook)
(if (null proc-name) (setq proc-name (concat "P4 " (car args))))
;; This allows us to prompt the user for a client, if one is needed
(if (not (string= (car args) "-c"))
(let ((explicit-client (p4-client)))
(if explicit-client
(setq args (append (list "-c" explicit-client) args)))))
(p4-debug "asynch %s: %s" p4-executable args)
(p4-erase-buffer (concat "*" proc-name "*"))
(setq buf (apply 'make-comint proc-name p4-executable nil args))
(save-excursion
(set-buffer buf) (goto-char (point-min))
(insert-before-markers "*** Kill this buffer to abort " proc-name "\n"))
(display-buffer buf)
(let ((w (get-buffer-window buf nil))) (and w (select-window w)))
(setq proc (get-buffer-process buf))
(and sentinel (set-process-sentinel proc sentinel))
proc))
(defalias 'p4-exec-p4-fast 'p4-exec-p4)
(defun p4-exec-p4 (output-buf &rest args)
"Exec p4, putting output in OUTPUT-BUF, passing ARGS.
OUTPUT-BUFFER may be a buffer or the name of a buffer; if it is nil,
p4-output-buffer-name is used.
If you use -c to specify a client, it must be the first option."
(apply 'p4-exec-p4-low
output-buf p4-executable 'explicit-client args))
(defun p4-exec-p4-low (output-buf executable explicit-client-p &rest args)
"Helper function for p4-exec-p4-*."
(run-hooks 'p4-before-execute-hook)
(or output-buf (setq output-buf p4-output-buffer-name))
(let ((exec-dir default-directory))
(save-excursion
(set-buffer (get-buffer-create output-buf))
(setq default-directory exec-dir)
(if p4-exec-erase-buffer (erase-buffer) (goto-char (point-max)))
(setq args (remove-if-not 'identity args)) ; chuck nulls
;; optionally require client to be passed via -c
(if (and explicit-client-p (not (string= (car args) "-c")))
(let ((explicit-client (p4-client)))
(if explicit-client
(setq args (append (list "-c" explicit-client) args)))))
(p4-debug "exec %s: %s" executable args)
(apply 'call-process executable nil output-buf nil args)
(p4-if-win32
(if (p4-re-search-buffer output-buf "^Unknown command")
(error "P4: unknown command. Is executable in a directory that contains a space?"))))))
(defun p4-re-search-buffer (buf regexp)
"Checks p4-output-buffer for output that looks like REGEXP"
(save-excursion
(set-buffer buf)
(save-excursion
(goto-char (point-min))
(re-search-forward regexp nil t))))
(defun p4-filter-output (buffer form)
(or buffer (setq buffer p4-output-buffer-name))
(setq buffer (get-buffer buffer))
(if (null buffer) nil
(save-excursion
(set-buffer buffer)
(goto-char (point-min))
(eval form))))
;; Some fns don't want their windows to be rearranged; they can bind
;; this to t in a let statement and take advantage of dynamic scope
(defvar p4-inhibit-display-shrink nil)
(defun p4-display-output (buffer &optional one-line-str temporary-p)
"Display output in a shrunken window.
If BUFFER is nil, display `p4-output-buffer-name'.
If ONE-LINE-STR passed and output is small, display it in minibuffer.
if TEMPORARY-P, window only stays until the next input event."
(or buffer (setq buffer p4-output-buffer-name))
(setq buffer (get-buffer buffer))
(if (null buffer) nil
(save-excursion
(set-buffer buffer)
(goto-char (point-min))
(let ((lines (count-lines (point-min) (point-max)))
(maxwidth (- (frame-width) (length one-line-str) 6))
str)
(cond ((and one-line-str (= lines 0))
(message "%s: No output" one-line-str))
((and one-line-str (= lines 1))
(setq str (buffer-substring (point-min)
(progn (end-of-line) (point))))
(if (> (length str) maxwidth)
(setq str (concat "..." (substring str (- maxwidth)))))
(message "%s: %s" one-line-str str))
(t (let ((wc (current-window-configuration)))
(if p4-inhibit-display-shrink
(display-buffer buffer)
(delete-windows-on buffer)
(display-buffer buffer)
(set-window-start
(get-buffer-window buffer) 0)
(shrink-window-if-larger-than-buffer
(get-buffer-window buffer)))
(if temporary-p
(unwind-protect
(let ((target ? ) e)
(message "Hit SPC to continue")
(while (and (setq e (read-event))
(not (listp e)) ;char event
(not (equal e target)))
(if (numberp e) (setq e (char-to-string e)))
(message "Hit SPC (not '%s') to continue" e)))
(set-window-configuration wc))))))))))
;;; -----------------------------------------------------------------
;;; User-level commands
;;; -----------------------------------------------------------------
(defun p4-toggle-read-only ()
"Do the logical \"next thing\" to the current buffer.
If buffer is closed, open it for edit or add.
If it's open/edit and unmodified, revert it.
If it's open/edit and modified, merge it or submit it.
If it's open/add, prompt for submit or revert."
(interactive)
(p4-buffer-sync)
(run-hooks 'p4-before-execute-hook)
(let* (status err action headrev haverev)
(cond
((null buffer-file-name) (toggle-read-only))
((progn (setq status (p4-fstat (buffer-file-name) t)
err (and (symbolp (car status)) (car status))
headrev (cdr (assoc "headRev" status))
haverev (cdr (assoc "haveRev" status))
action (cdr (assoc "action" status)))
nil))
;; errors, and cases that don't require the file to be open
((eq err 'bad-client)
(error "File not under client root %s" (p4-get-client-root)))
((eq err 'not-in-depot)
(if (y-or-n-p (format "Open '%s' for add? "
(file-name-nondirectory (buffer-file-name))))
(call-interactively 'p4-add)
(message "Nothing done.")))
((eq err 'not-in-view)
(message "%s is not in your client view"
(file-name-nondirectory buffer-file-name)))
;; sync if the client contains non-head rev
((not (string= headrev haverev))
(cond ((and (null action)
(y-or-n-p
(format "Sync from #%s to head revision #%s first? "
haverev headrev)))
(p4-exec-p4-fast nil "sync" buffer-file-name)
(p4-revert-buffer t t)
(p4-display-output nil "Sync" 'temporary))
((and action
(y-or-n-p "Merge in changes? "))
(call-interactively 'p4-update-current-buffer))
((null action)
(call-interactively 'p4-edit))
(t (message "Nothing done."))))
((null (setq action (cdr (assoc "action" status))))
(call-interactively 'p4-edit))
;; normal cases (file is open, and has an action)
;; resolve if unresolved
((assoc "unresolved" status)
(if (y-or-n-p "Resolve/merge this file? ")
(call-interactively 'p4-update-current-buffer)
(message "Nothing done.")))
;; edit: revert if unchanged, otherwise submit
((string= action "edit")
(if (assoc "modified" status)
(if (string= headrev haverev)
(call-interactively 'p4-submit)
(message "Can't submit file at non-head revision."))
(p4-revert (buffer-file-name) 'no-questions)))
;; add: prompt for revert or submit
((string= action "add")
(cond ((y-or-n-p "File opened for add: submit? ")
(call-interactively 'p4-submit))
((y-or-n-p "File opened for add: un-add? ")
(p4-revert (buffer-file-name) 'no-questions))
(t (message "Nothing done."))))
;; integrates always submit, even if unchanged
((string= action "integrate")
(call-interactively 'p4-submit))
(t (error "Don't know what to do with action %s!" action)))))
(defun p4-reset ()
"Resets any caches kept by p4.el"
(interactive)
(run-hooks 'p4-reset-hook))
(defun p4-edit ()
"Open current buffer for editing"
(interactive)
(p4-buffer-sync)
(message "Opening file for edit...")
(p4-exec-p4-fast nil "edit" (buffer-file-name))
(p4-revert-buffer t t)
;; make the the "also opened by" text a little more readable
(p4-filter-output
nil '(while (re-search-forward "^\\.\\.\\. //\\S-* - " nil t)
(replace-match "... ")))
(p4-filter-output
nil '(while (search-forward "@" nil t)
(forward-char -1) (indent-to 32) (forward-char 1)))
(p4-display-output nil "Edit" 'temporary))
(defun p4-add ()
"Register current buffer's file with p4"
(interactive)
(or (buffer-file-name) (error "Buffer has no associated file"))
(let* ((file (buffer-file-name))
(small-file (file-name-nondirectory file))
(needs-df (not (string= (downcase file) file)))
(dot-pos (string-match "\\.\\|$" small-file))
;; (needs-8 (or (> dot-pos 8)
;; (> (- (length small-file) dot-pos) 4)))
df-arg)
;; p4.pl enforces 8.3 and lowercase on all files
(if (and p4-use-geoworks-extensions
needs-df
(y-or-n-p "Override case restrictions? "))
(setq df-arg "-df"))
(p4-exec-p4 nil "add" "-t" p4-default-file-type df-arg (buffer-file-name))
(p4-filter-output nil
'(if (re-search-forward "with type \\(.*\\)\\." nil t)
(let (type)
(setq type (match-string 1))
(forward-line 1)
(delete-region (point-min) (point))
(end-of-line)
(insert (format ", type %s" type)))))
(p4-display-output nil "Add" 'temporary)))
;; this unlocks the file from editing mode,
;; losing all current changes and reverting to read-only
;; if the file has been modified, it asks the user if they really
;; want to do this
(defun p4-revert (&optional file no-questions)
"Close FILE (default current file).
Discards changes if edited, cancels add if added.
If NO-QUESTIONS, don't confirm destructive operations."
(interactive)
(if (null file) (setq file (buffer-file-name)))
(let ((current-buffer-p (string= file (buffer-file-name))))
(if (and (not no-questions)
(or (buffer-modified-p)
(assoc "modified" (p4-fstat file t)))
(not (yes-or-no-p
(format "Throw away changes to %s? "
(file-name-nondirectory file)))))
(message "Revert aborted.")
;; just in case some buggy code erroneously reverts a file...
(if no-questions
(let ((backup-file (concat (or (getenv "TEMP") "") "/p4lastrevert")))
(write-region (point-min) (point-max) backup-file nil 'nomsg)
(message "Reverting... copy kept in %s" backup-file))
(message "Reverting..."))
(p4-exec-p4 nil "revert" file)
(if current-buffer-p
;; this is faster and nicer on the user
(p4-revert-buffer t t)
(p4-sync-buffers))
(p4-display-output nil "Revert" 'temporary))))
(defun p4-diff (&optional file)
"Diff a file against its base checked-out revision.
Interactively, diffs the current buffer.
If FILE is nil, diff all changed files in current client view.
If FILE is a list of strings, diff multiple files."
(interactive (list (buffer-file-name)))
(message "Diffing %s against depot..."
(cond ((null file) "all open files")
((stringp file) (file-name-nondirectory file))
((= (length file) 1) (file-name-nondirectory (car file)))
(t (format "[%s files]" (length file)))))
(or (listp file) (setq file (list file)))
(apply 'p4-exec-p4 "*P4 diff*" "diff" p4-diff-type file)
(save-excursion
(set-buffer "*P4 diff*")
(run-hooks 'p4-diff-hook)
(goto-char (point-min)))
(p4-display-output "*P4 diff*" "Diff"))
(defun p4-submit-change (change)
"Submit a set of files.
CHANGE may be \"default\", or a changelist number."
(interactive (list (p4-prompt-for-change)))
(p4-change change))
(defun p4-submit (&optional change-desc)
"Submit just the current buffer, prompting for a change string.
If optional CHANGE-DESC is provided, performs the submit with no
further user intervention needed.
See also the variable `p4-quick-submit'."
(interactive)
(p4-buffer-sync)
;; It's nicer if the prompt comes up quickly so user can quit out
;; immediately if it's a mistake.
(if (and (null change-desc) p4-quick-submit)
(setq change-desc (read-string "Change description: ")))
(let* ((local-name (buffer-file-name))
(depot-name
(with-temp-buffer
(p4-exec-p4-fast (current-buffer) "opened" local-name)
(if (not (re-search-forward "\\(//.*\\)#.*default change" nil t))
(error "File not open in default change."))
(match-string 1)))
(buffer (or (p4-change-noselect "default")
(error "Error creating new change"))))
;; If there is a description, insert it and submit
;; otherwise, display for the user to edit and submit
(save-excursion
(set-buffer buffer)
(goto-char (point-min))
(re-search-forward "<enter description here>")
(if change-desc
(replace-match change-desc t t)
(goto-char (match-beginning 0)))
(save-excursion
(re-search-forward "Files:")
(delete-region (point) (point-max))
(insert "\n\t" depot-name "\n")
(if change-desc
nil ;;(p4-cm-submit)
)))
(if (null change-desc)
(pop-to-buffer buffer)
;; file is submitted, and should now be readonly
(p4-revert-buffer t t)
)))
(defvar p4-change-prompt-map nil)
(defvar p4-change-prompt-hist nil
"History variable for use with p4-prompt-for-change")
(if p4-change-prompt-map nil
(let ((map (copy-keymap minibuffer-local-completion-map)))
(substitute-key-definition
'minibuffer-completion-help
(lambda () (interactive) (p4-display-output "*Pending Changes*"))
map)
(setq p4-change-prompt-map map)))
(defun p4-prompt-for-change (&optional prompt)
"Return a pending change or \"default\""
(or prompt (setq prompt "Change: "))
(let ((pend-buf "*Pending Changes*")
change-num)
(p4-exec-p4-fast pend-buf "changes" "-s" "pending")
(save-excursion
(set-buffer pend-buf) (goto-char (point-min))
(keep-lines (concat "@" (p4-client))))
;; If empty, don't bother prompting
(if (p4-re-search-buffer pend-buf "\\`\\'")
(setq change-num "default")
(save-window-excursion
(save-excursion
(set-buffer pend-buf)
(goto-char (point-min))
(insert (format "Pending changes for client %s:\n" (p4-client))))
(let ((minibuffer-local-must-match-map p4-change-prompt-map)
(table '(("default"))))
(p4-filter-output
pend-buf
'(while (re-search-forward
"Change \\([0-9]+\\).*\\(@.*pending.\\)" nil t)
(setq table (cons (list (match-string 1)) table))
(replace-match "" t t nil 2)))
(p4-display-output pend-buf)
(setq change-num
(completing-read prompt table nil t nil
'p4-change-prompt-hist
"default"))
)))
(p4-kill-buffer pend-buf)
;;(message "got %S" change-num) (sit-for 2) (error "done")
change-num))
(defun p4-sync-buffers ()
"Make read-only any readable buffers that have been submitted read-only"
(interactive)
(let ((fn (lambda (buf)
(save-excursion
(set-buffer buf)
(p4-revert-buffer t t)))))
(if p4-auto-sync-buffer
(mapcar (lambda (b)
(if (p4-sync-helper b)
(apply fn (list b))))
(buffer-list))
(map-y-or-n-p 'p4-sync-helper fn (buffer-list)))))
(defun p4-sync-helper (buffer)
;; Return a prompt for buffers that look like files touched by Perforce
;; We check that the buffer's contents and read-only status haven't changed.
(if (and
(buffer-file-name buffer)
(file-exists-p (buffer-file-name buffer))
(not (file-directory-p (buffer-file-name buffer)))
(or (not (verify-visited-file-modtime buffer))
(and (not (null (buffer-file-name buffer)))
(not (eq (not (file-writable-p (buffer-file-name buffer)))
(save-excursion
(set-buffer buffer)
buffer-read-only))))))
(format "Revert buffer %s? " (buffer-name buffer))
nil))
;;; -----------------------------------------------------------------
;;; Misc utils used by this file
;;; -----------------------------------------------------------------
(defun p4-fstat (file &optional full)
"Returns an alist of fstat information for FILE, or an error token.
Optional arg FULL non-nil means return extended fstat info; currently
this just adds modified status if the file is open.
Error token is one of '(not-in-depot), '(bad-client), '(not-in-view)."
(let ((b " *p4 fstat*")
l)
;; p4 fstat with no arguments is a Bad Thing to do
(if (or (null file) (string= file ""))
(error "fstat with no arg"))
(p4-exec-p4-fast b "fstat" file)
(save-excursion
(set-buffer b) (goto-char (point-min))
(if (not (looking-at "\\.\\.\\."))
;; Some sort of error occurred
(cond ;; file doesn't exist at all in depot
((looking-at ".*no such file") '(not-in-depot))
;; file under different client root
((looking-at ".*not under") '(bad-client))
;; file in depot but not in client view (wack error msg)
((looking-at ".*up-to-date") '(not-in-view)))
;; the '.' in [^ .\n] is to filter out "otherOpenNN" lines
(while (re-search-forward "^... \\([^ .\n]+\\) \\(.*\\)" nil t)
(setq l (cons (cons (match-string 1) (match-string 2)) l)))
(if (and full (assoc "action" l))
(save-excursion
(p4-exec-p4-fast b "diff" "-sr" file)
(set-buffer b) (goto-char (point-min))
;; if there is any output, the file has either not been modified,
;; or "modified" doesn't make sense (ie, open for add)
(if (looking-at "\\`\\'")
(setq l (cons (cons "modified" t) l)))))
(or p4-debug (kill-buffer b))
(nreverse l)))))
(defun p4-autodetect-perforce-tmp ()
"Detect Perforce-generated temporary files.
Put them into special modes."
;; Verify that we are first in the hook list. Bad things happen
;; if generic-mode-find-file-hook comes first.
(if (and (not (eq (car-safe find-file-hooks) 'p4-autodetect-perforce-tmp))
(memq 'p4-autodetect-perforce-tmp find-file-hooks))
(progn
(remove-hook 'find-file-hooks 'p4-autodetect-perforce-tmp)
(add-hook 'find-file-hooks 'p4-autodetect-perforce-tmp)))
;; Automatically puts buffers into p4-view-mode or p4-protect-mode.
;; This assumes p4 uses gnuclient/emacsclient as an editor
(if (and buffer-file-name
(or (string-match "\\.tmp\\'" buffer-file-name)
(string-match "tmp\\." buffer-file-name))
(eq major-mode 'fundamental-mode))
(save-excursion
(goto-char (point-min))
(cond ((looking-at "# A Perforce \\(Branch\\|Client\\)")
(p4-view-mode))
((looking-at "# A Perforce Job Specification")
(p4-job-mode))
;; customize stuff doesn't work with 19
((and (>= emacs-major-version 20)
(looking-at "#.*Perforce Protections"))
(p4-protect-mode))))
nil))
(add-hook 'find-file-hooks 'p4-autodetect-perforce-tmp)
(defun p4-debug (&rest args)
(if (and p4-debug (get-buffer "*P4-debug*"))
(save-excursion
(set-buffer "*P4-debug*")
(goto-char (point-max))
(insert (apply 'format args) "\n"))))
(defvar p4-client-roots '() "Cached alist of client->client root")
(add-hook 'p4-reset-hook (lambda () (setq p4-client-roots nil)))
(defun p4-get-client-root (&optional client)
"Get the client root dir for CLIENT or the current client.
In NT, the returned path will use forward slashes.
Raises an error if the current client can't be determined."
;; Need to have client set, otherwise caching will be screwed
(or client (setq client (p4-client)))
(or client (error "Can't determine client to find client root"))
(if (not (assoc client p4-client-roots))
(save-excursion
(if client
(p4-exec-p4-fast p4-output-buffer "-c" client "info")
(p4-exec-p4-fast p4-output-buffer "info"))
(set-buffer p4-output-buffer)
(goto-char (point-min))
(if (not (search-forward "Client root: " nil t))
(if (search-forward "Client unknown" nil t)
(error "Invalid Perforce client: %s" client)
(error "?? No client root: %s" client)))
(let ((root (buffer-substring (point) (progn (end-of-line) (point)))))
;; hack for win32 -- this makes root somewhat canonical
(p4-if-win32 (setq root (file-truename root)))
(setq root (concat root "/"))
(and client (add-to-list 'p4-client-roots (cons client root)))
(p4-if-win32 (file-truename root) root))))
(cdr (assoc client p4-client-roots)))
(defun p4-make-window-context (w)
;; Return a cookie that allows one to restore a window, perhaps containing
;; a slightly modified buffer, to the way it looked before. Tries to move
;; point to the same line (content-wise, not line-number-wise), and
;; preserves point's location relative to the beginning of the window.
"Returns a context cookie for W, consisting of (LINE STRING START-DELTA)."
(save-excursion
(set-buffer (window-buffer w))
(let* ((point-line (1+ (count-lines 1 (save-excursion
(beginning-of-line) (point)))))
(point-string (save-excursion
(buffer-substring
(progn (beginning-of-line) (point))
(progn (end-of-line) (point)))))
(start-line (1+ (count-lines 1 (window-start w))))
(start-delta (- start-line point-line))
(start-column (current-column)))
(list point-line point-string start-delta start-column))))
(defun p4-restore-window-context (w c)
;; Use a cookie created by p4b-make-window-context to restore a window.
"Restore window W to context passed in C"
(let ((point-line (nth 0 c))
(point-string (nth 1 c))
(start-delta (nth 2 c))
(start-column (nth 3 c))
(old-buf (current-buffer)))
(set-buffer (window-buffer w))
;; Try to stay in the same relative place in file
(goto-line point-line)
(or (search-forward point-string (+ (point) 500) t)
(search-backward point-string (- (point) 500) t)
(search-forward point-string nil t)
(search-backward point-string nil t))
(beginning-of-line)
(move-to-column start-column)
(set-window-start w (save-excursion (forward-line start-delta) (point)))
(set-window-point w (point))
(set-buffer old-buf)))
(defun p4-revert-buffer (arg1 arg2)
"Like revert-buffer but try and keep window looking the same.
This is not the same as the user-level command p4-revert!"
(let* ((wl (get-buffer-window-list (current-buffer) nil t))
(cl (mapcar 'p4-make-window-context wl)))
(revert-buffer arg1 arg2)
(mapcar* 'p4-restore-window-context wl cl)))
;; (defun p4-revert-buffer (arg1 arg2)
;; "Like revert-buffer but try and keep window looking the same.
;; This is not the same as the user-level command p4-revert!"
;; (let ((old-start (window-start))
;; (old-point (point))
;; (old-mark (mark t))
;; (buf-window (get-buffer-window (current-buffer) t))
;; buf-window-point)
;; (and buf-window (setq buf-window-point (window-point buf-window)))
;; (revert-buffer arg1 arg2)
;; (goto-char old-point)
;; (set-mark old-mark)
;; (and buf-window (set-window-point buf-window buf-window-point))
;; (and buf-window (set-window-start buf-window old-start t))))
(defun p4-kill-buffer (buf-name)
(if (get-buffer buf-name)
(progn
(delete-windows-on buf-name)
(kill-buffer buf-name))))
(defun p4-erase-buffer (buf-name)
(and (get-buffer buf-name)
(save-excursion (set-buffer buf-name) (erase-buffer))))
(defun p4-depot-to-local (depot-path)
"Given a //depot/... style path, convert to a path on the local filesystem.
Returns nil if unsuccessful."
;; First try guessing where the file is, by appending successively
;; shorter versions of depot-path to the client root
(or (catch 'found
(let ((cursor (substring depot-path 2))
(root (p4-get-client-root))
(i 0))
(while (and (string-match "^[^/]*/" cursor)
(setq cursor (substring cursor (match-end 0))))
(if (> (setq i (1+ i)) 100) (error "infinite loop"))
(let ((guess (concat root cursor)))
(if (file-exists-p guess)
(throw 'found guess))))
nil))
(cdr (assoc "clientFile" (p4-fstat depot-path)))))
(defun p4-buffer-sync (&optional buffer)
"Make sure the current buffer and its working file are in sync."
(save-excursion
(if buffer (set-buffer buffer))
(if (buffer-modified-p)
(if (y-or-n-p (format "Buffer %s modified; save it? " (buffer-name)))
(save-buffer)
(error "Buffer contains unsaved changes, operation aborted")))))
;; unused
;(defun p4-sync-after-submit (buffer)
; ;; Make sure buffer reflects what's on disk; eg after submitting
; ;; buffers that were submitted will still be read-write when the
; ;; file is read-only
; (if (or
; ;; Check if buffer and file don't match
; (not (verify-visited-file-modtime buffer))
; ;; Check if buffer-writable and file-writable status are different
; ;; This might annoy people who use find-file-read-only. Whatever.
; (and (not (null (buffer-file-name buffer)))
; (not (eq (not (file-writable-p (buffer-file-name buffer)))
; (save-excursion (set-buffer buffer) buffer-read-only)))))
; (if (and
; ;; argh -- verify-visited-file-modtime lets this through
; (file-exists-p (buffer-file-name buffer))
; (not (file-directory-p (buffer-file-name buffer)))
; (y-or-n-p (format "Revert buffer %s? " (buffer-name buffer))))
; (save-excursion
; (set-buffer buffer)
; (p4-revert-buffer t t)))
; t))
(provide 'p4)
| # | Change | User | Description | Committed | |
|---|---|---|---|---|---|
| #4 | 464 | paul_dubois |
code drop. changes: - add jobs shme to menu - fix bug with p4-changes - p4-toggle-read-only now offers to edit file if user declines syncing to head revision - clean up docs for p4-jobs |
||
| #3 | 303 | paul_dubois | Fix typo | ||
| #2 | 302 | paul_dubois |
Remove dependency on gw-utils.el A batch of small bug fixes, mostly dealing with depots that aren't named "depot" |
||
| #1 | 301 | paul_dubois | Initial checkpoint of p4.el |