cgit.sxemacs.org Git - packages/blob - xemacs-packages/prog-modes/p4.el

   1 ;;; p4.el --- Simple Perforce-Emacs Integration
   2 ;;
   3 ;; $Id: p4.el,v 1.37 2002/07/31 23:24:44 petero2 Exp $
   4
   5 ;;; Commentary:
   6 ;;
   7 ;;    Applied the GNU G.P.L. to this file - rv 3/27/1997
   8
   9 ;;    Programs for  Emacs <-> Perforce Integration.
  10 ;;    Copyright (C) 1996, 1997  Eric Promislow
  11 ;;    Copyright (C) 1997-2003   Rajesh Vaidheeswarran
  12 ;;
  13 ;;    This program is free software; you can redistribute it and/or modify
  14 ;;    it under the terms of the GNU General Public License as published by
  15 ;;    the Free Software Foundation; either version 2 of the License, or
  16 ;;    (at your option) any later version.
  17 ;;
  18 ;;    This program is distributed in the hope that it will be useful,
  19 ;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;;    GNU General Public License for more details.
  22 ;;
  23 ;;    You should have received a copy of the GNU General Public License
  24 ;;    along with this program; if not, write to the Free Software
  25 ;;    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  26 ;;
  27 ;;    If you have any problems to report, or suggestions, please send them
  28 ;;    to p4el-bugs@lists.sourceforge.net
  29
  30 ;; LCD Archive Entry:
  31 ;; p4|Rajesh Vaidheeswarran|rv@NoSpAm.lOsEtHiS.dsmit.com|
  32 ;; P4 SCM Integration into Emacs/XEmacs|
  33 ;; 2003/09/12|10.3|not_assigned_yet|
  34
  35 ;; WARNING:
  36 ;; --------
  37 ;;
  38 ;;    % p4 edit foo.c
  39 ;;    ... make changes to foo.c in emacs
  40 ;;    % p4 submit
  41 ;;     ... keep the writable copy of foo.c in emacs.  Start making changes
  42 ;;     to it.  Discover that you can't save it.  If you do M-x:p4-edit,
  43 ;;     you'll lose your changes.  You need to do a 'p4 edit' at the
  44 ;;     command-line.
  45 ;;
  46
  47 ;; NOTES:
  48 ;; ------
  49 ;;
  50 ;; It is best if you take this file and byte compile it. To do that, you
  51 ;; need to do the following:
  52 ;;
  53 ;; % emacs -batch -f batch-byte-compile /full/path/to/file/p4.el
  54 ;;
  55 ;; This creates a binary file p4.elc in the path. Add the path to your
  56 ;; load-path variable in .emacs like this:
  57 ;;
  58 ;; (setq load-path (cons "/full/path/to/file" load-path))
  59 ;;
  60 ;; Then add the library like this:
  61 ;;
  62 ;; (load-library "p4")
  63 ;;
  64
  65 ;;; Code:
  66
  67 (defvar p4-emacs-version "10.3" "The Current P4-Emacs Integration Revision.")
  68
  69 ;; Find out what type of emacs we are running in. We will be using this
  70 ;; quite a few times in this program.
  71 (eval-and-compile
  72   (defvar p4-running-emacs nil
  73     "If the current Emacs is not XEmacs, then, this is non-nil.")
  74   (defvar p4-running-xemacs nil
  75     "If the current Emacs is XEmacs/Lucid, then, this is non-nil.")
  76   (if (string-match "XEmacs\\|Lucid" emacs-version)
  77       (setq p4-running-xemacs t)
  78     (setq p4-running-emacs t)))
  79
  80 ;; Pick up a couple of missing function defs
  81 (if p4-running-xemacs
  82     (eval-when-compile
  83       (require 'timer)
  84       (require 'dired)))
  85
  86 (defvar p4-emacs-maintainer
  87   "p4.el maintainers <p4el-bugs@lists.sourceforge.net>"
  88   "The maintainer(s) of the emacs-p4 integration. Used for bug reports.")
  89
  90 (defvar p4-web-page "http://p4el.sourceforge.net/" "The home of p4.el.")
  91
  92 ;; For flavors of Emacs which don't define `defgroup' and `defcustom'.
  93 (eval-when-compile
  94   (if (not (fboundp 'defgroup))
  95       (defmacro defgroup (sym memb doc &rest args)
  96         "Null macro for defgroup in all versions of Emacs that don't define
  97 defgroup"
  98         t))
  99   (if (not (fboundp 'defcustom))
 100       (defmacro defcustom (sym val doc &rest args)
 101         "Macro to alias defcustom to defvar in all versions of Emacs that
 102 don't define defcustom"
 103         `(defvar ,sym ,val ,doc))))
 104
 105 (defgroup p4 nil "Perforce VC System." :group 'tools)
 106
 107 ;; This can be set to wherever 'p4' lies using p4-set-p4-executable
 108 (eval-and-compile
 109   (defun p4-windows-os ()
 110     (memq system-type '(ms-dos windows-nt)))
 111
 112   (defcustom p4-executable
 113     (let ((lst (append
 114                 exec-path
 115                 (list "/usr/local/bin/p4"
 116                       (concat (getenv "HOME") "/bin/p4")
 117                       "p4")))
 118           (p4-progname (if (p4-windows-os) "p4.exe" "p4"))
 119           p4ex)
 120       (while (and lst (not p4ex))
 121         (let ((tmp (concat (file-name-as-directory (car lst))
 122                            p4-progname)))
 123           (if (and (file-executable-p tmp)
 124                    (not (file-directory-p tmp)))
 125               (setq p4ex tmp))
 126           (setq lst (cdr lst))))
 127       p4ex)
 128     "This is the p4 executable.
 129 To set this, use the function  `p4-set-p4-executable' or `customize'"
 130     :type 'string
 131     :group 'p4))
 132
 133 ;; This is a string with default arguments to pass to "p4 diff",
 134 ;; "p4 diff2", "p4 describe", etc.
 135 (defcustom p4-default-diff-options "-du"
 136   "Type of p4 diff output to be displayed. \(regular or context or
 137 unified.\)"
 138   :type 'string
 139   :group 'p4)
 140
 141 (defcustom p4-default-depot-completion-prefix "//depot/"
 142   "Prefix to be used for completion prompt when prompting user for a depot
 143 file."
 144   :type 'string
 145   :group 'p4)
 146
 147 ;; Set this variable to nil to turn off colorized diff buffers.
 148 (defcustom p4-colorized-diffs t
 149   "Set this to nil to disable colorized diffs."
 150   :type 'boolean
 151   :group 'p4)
 152
 153 ;; Set whether P4CONFIG should be used exclusively for VC checking
 154 (defcustom p4-use-p4config-exclusively nil
 155   "Whether P4 mode should use P4CONFIG exclusively to check whether a file
 156 is under P4 version control. If set to nil, `p4-check-mode' is always
 157 called; otherwise, it checks to see if the file named by P4CONFIG exists in
 158 this or a parent directory, and if so, only then runs p4-check-mode.
 159
 160 This provides for a much faster `p4-find-file-hook'."
 161   :type 'boolean
 162   :group 'p4)
 163
 164 ;; Auto-refresh?
 165 (defcustom p4-auto-refresh t
 166   "Set this to automatically refresh p4 submitted files in buffers."
 167   :type 'boolean
 168   :group 'p4)
 169
 170 ;; Check for empty diffs at submit time
 171 (defcustom p4-check-empty-diffs t
 172   "Set this to check for files with empty diffs before submitting."
 173   :type 'boolean
 174   :group 'p4)
 175
 176 (defcustom p4-verbose t
 177   "When set, p4 will pop up the output buffer with the result of the
 178 command."
 179   :type 'boolean
 180   :group 'p4)
 181
 182 ;; Follow Symlinks?
 183 (defcustom p4-follow-symlinks nil
 184   "When set, p4 will call `file-truename' on all opened files."
 185   :type 'boolean
 186   :group 'p4)
 187
 188 (defcustom p4-mode-hook nil
 189   "Hook run by `p4-mode'."
 190   :type 'sexp
 191   :group 'p4)
 192
 193 (eval-and-compile
 194   (defvar p4-output-buffer-name "*P4 Output*" "P4 Output Buffer."))
 195
 196 ;; Set this variable in .emacs if you want p4-set-client-name to complete
 197 ;; your client name for you.
 198 (defvar p4-my-clients nil
 199   "This variable holds the alist of p4 clients that the function
 200 `p4-set-client-name' can complete on.
 201
 202 Set this variable *only* if you don't want P4 to complete on all the clients
 203 in the P4 server.
 204
 205 This is a alist, and should be set using the function
 206 `p4-set-my-clients'. For example, in your .emacs:
 207
 208 \(load-library \"p4\"\)
 209 \(p4-set-my-clients \'(client1 client2 client3)\)")
 210
 211 ;; Set this variable in .emacs if you want to alter the completion
 212 ;; behavior of p4-set-client-name.
 213
 214 (defcustom p4-strict-complete t
 215   "Set this variable in .emacs \(or using `customize'\) if you want to alter
 216 the completion behavior of `p4-set-client-name'.
 217 "
 218   :type 'boolean
 219   :group 'p4)
 220
 221 (if (not (getenv "P4PORT"))
 222     (setenv "P4PORT" "perforce:1666"))
 223
 224 (defvar p4-notify-list (getenv "P4NOTIFY") "The P4 Notify List.")
 225
 226 (defcustom p4-sendmail-program (if (boundp 'sendmail-program)
 227                                    sendmail-program
 228                                  nil)
 229   "The sendmail program. To set this use `customize'."
 230   :type 'string
 231   :group 'p4)
 232
 233 (defcustom p4-user-email (if (boundp 'user-mail-address)
 234                              user-mail-address nil)
 235   "The e-mail address of the current user. This is used with the
 236 notification system, and must be set if notification should take place. To
 237 set this, use `customize'."
 238   :type 'string
 239   :group 'p4)
 240
 241 (defcustom p4-notify nil
 242   "If this is t then the users in the notification list set by
 243 `p4-set-notify-list' will get a notification of any P4 change submitted from
 244 within emacs."
 245   :type 'boolean
 246   :group 'p4)
 247
 248 ;; This can be set with p4-toggle-vc-mode
 249 (defcustom p4-do-find-file t
 250   "If non-nil, the `p4-find-file-hook' will run when opening files."
 251   :type 'boolean
 252   :group 'p4)
 253
 254 ;; Now add a hook to find-file-hooks
 255 (add-hook 'find-file-hooks 'p4-find-file-hook)
 256 ;; .. and one to kill-buffer-hook
 257 (add-hook 'kill-buffer-hook 'p4-kill-buffer-hook)
 258
 259 ;; Tell Emacs about this new kind of minor mode
 260 (defvar p4-mode nil "Is this file under p4?")
 261 (make-variable-buffer-local 'p4-mode)
 262 (put 'p4-mode 'permanent-local t)
 263
 264 (defvar p4-offline-mode nil "Is this file under p4 but handled in offline mode?")
 265 (make-variable-buffer-local 'p4-offline-mode)
 266 (put 'p4-offline-mode 'permanent-local t)
 267
 268 (defvar p4-minor-map
 269   (let ((map (make-sparse-keymap)))
 270     (define-key map "\C-x\C-q" 'p4-toggle-read-only)
 271     map)
 272   "Keymap for p4 minor mode")
 273 (fset 'p4-minor-map p4-minor-map)
 274 (or (assoc 'p4-mode minor-mode-alist)
 275     (setq minor-mode-alist (cons '(p4-mode p4-mode)
 276                                  minor-mode-alist)))
 277 (or (assoc 'p4-mode minor-mode-map-alist)
 278     (setq minor-mode-map-alist
 279           (cons '(p4-mode . p4-minor-map) minor-mode-map-alist)))
 280 (or (assoc 'p4-offline-mode minor-mode-alist)
 281     (setq minor-mode-alist (cons '(p4-offline-mode p4-offline-mode)
 282                                  minor-mode-alist)))
 283 (or (assoc 'p4-offline-mode minor-mode-map-alist)
 284     (setq minor-mode-map-alist
 285           (cons '(p4-offline-mode . p4-minor-map) minor-mode-map-alist)))
 286
 287 (defvar p4-async-minor-mode nil
 288   "The minor mode for editing p4 asynchronous command buffers.")
 289 (make-variable-buffer-local 'p4-async-minor-mode)
 290 (defvar p4-async-minor-map (make-sparse-keymap) "Keymap for p4 async minor mode")
 291 (fset 'p4-async-minor-map p4-async-minor-map)
 292
 293 (or (assoc 'p4-async-minor-mode minor-mode-alist)
 294     (setq minor-mode-alist
 295           (cons '(p4-async-minor-mode " P4") minor-mode-alist)))
 296
 297 (or (assoc 'p4-async-minor-mode minor-mode-map-alist)
 298     (setq minor-mode-map-alist
 299           (cons '(p4-async-minor-mode . p4-async-minor-map) minor-mode-map-alist)))
 300
 301 (defvar p4-current-command nil)
 302 (make-variable-buffer-local 'p4-current-command)
 303 (put 'p4-current-command 'permanent-local t)
 304 (set-default 'p4-current-command nil)
 305
 306 (defvar p4-current-args nil)
 307 (make-variable-buffer-local 'p4-current-args)
 308 (put 'p4-current-args 'permanent-local t)
 309 (set-default 'p4-current-args nil)
 310
 311 ;; To check if the current buffer's modeline and menu need to be altered
 312 (defvar p4-vc-check nil)
 313 (make-variable-buffer-local 'p4-vc-check)
 314 (put 'p4-vc-check 'permanent-local t)
 315 (set-default 'p4-vc-check nil)
 316
 317 (defvar p4-set-client-hooks nil
 318   "List of functions to be called after a p4 client is changed.
 319 The buffer's local variables (if any) will have been processed before the
 320 functions are called.")
 321
 322 (if p4-running-emacs (require 'timer))
 323
 324 (defvar p4-timer nil "Timer object that will be set to cleanup the caches
 325 periodically.")
 326
 327 (defcustom p4-cleanup-time 600 "seconds after which `p4-cache-cleanup' will
 328 check for dirty caches."
 329   :type 'integer
 330   :group 'p4)
 331
 332 (defcustom p4-cleanup-cache t "`p4-cache-cleanup' will cleanup the
 333 branches/clients/dirs/labels caches once in a while if this is non-nil."
 334   :type 'boolean
 335   :group 'p4)
 336
 337 (defvar p4-all-buffer-files nil "An associated list of all buffers and
 338 their files under p4 version control. This is to enable autorefreshing of
 339 p4 submitted files being visited by the buffer.")
 340
 341 (defvar p4-file-refresh-timer nil "Timer object that will be set to refresh
 342 the files in Emacs buffers that have been modified by a `p4-submit'.")
 343
 344 (defcustom p4-file-refresh-timer-time 60 "seconds after which
 345 `p4-file-refresh' will check for modified files in Emacs buffers. Set this
 346 variable to 0 to disable periodic refreshing."
 347   :type 'integer
 348   :group 'p4)
 349
 350 (defvar p4-async-command-hook nil
 351   "This hook is run after an async buffer has been set up by
 352 `p4-async-process-command'")
 353
 354 (defvar p4-window-config-stack nil
 355   "Stack of saved window configurations.")
 356
 357 (defcustom p4-window-config-stack-size 20 "Maximum stack size
 358 for saved window configurations."
 359   :type 'integer
 360   :group 'p4)
 361
 362 (defcustom p4-exec-arg-len-max 20000 "Maximum total length of all
 363 arguments to p4 commands."
 364   :type 'integer
 365   :group 'p4)
 366
 367 (defvar p4-basic-map
 368   (let ((map (make-sparse-keymap)))
 369     (cond (p4-running-xemacs
 370            (define-key map [button2] 'p4-buffer-mouse-clicked)
 371            (define-key map [button3] 'p4-buffer-mouse-clicked-3))
 372           (p4-running-emacs
 373            (define-key map [mouse-2] 'p4-buffer-mouse-clicked)
 374            (define-key map [mouse-3] 'p4-buffer-mouse-clicked-3)))
 375     (define-key map [return] 'p4-buffer-commands)
 376     (define-key map "\r" 'p4-buffer-commands)
 377     (define-key map "q"  'p4-quit-current-buffer)
 378     (define-key map "k"  'p4-scroll-down-1-line)
 379     (define-key map "j"  'p4-scroll-up-1-line)
 380     (define-key map "b"  'p4-scroll-down-1-window)
 381     (define-key map [backspace] 'p4-scroll-down-1-window)
 382     (define-key map " "  'p4-scroll-up-1-window)
 383     (define-key map "<"  'p4-top-of-buffer)
 384     (define-key map ">"  'p4-bottom-of-buffer)
 385     (define-key map "="  'p4-delete-other-windows)
 386     map))
 387
 388 (defun p4-make-derived-map (base-map)
 389   (let (map)
 390     (cond (p4-running-xemacs
 391            (setq map (make-sparse-keymap))
 392            (set-keymap-parents map (list base-map)))
 393           (p4-running-emacs
 394            (setq map (cons 'keymap base-map))))
 395     map))
 396
 397 (defvar p4-filelog-map
 398   (let ((map (p4-make-derived-map p4-basic-map)))
 399     (define-key map "d"  'p4-diff2)
 400     (define-key map "f"  'p4-find-file-other-window)
 401     (define-key map "s"  'p4-filelog-short-format)
 402     (define-key map "l"  'p4-filelog-long-format)
 403     (define-key map "k"  'p4-scroll-down-1-line-other-w)
 404     (define-key map "j"  'p4-scroll-up-1-line-other-w)
 405     (define-key map "b"  'p4-scroll-down-1-window-other-w)
 406     (define-key map [backspace] 'p4-scroll-down-1-window-other-w)
 407     (define-key map " "  'p4-scroll-up-1-window-other-w)
 408     (define-key map "<"  'p4-top-of-buffer-other-w)
 409     (define-key map ">"  'p4-bottom-of-buffer-other-w)
 410     (define-key map "="  'p4-delete-other-windows)
 411     (define-key map "n"  'p4-goto-next-change)
 412     (define-key map "p"  'p4-goto-prev-change)
 413     (define-key map "N" (lookup-key map "p"))
 414     map)
 415   "The key map to use for selecting filelog properties.")
 416
 417 (defvar p4-opened-map
 418   (let ((map (p4-make-derived-map p4-basic-map)))
 419     (define-key map "n"  'p4-next-depot-file)
 420     (define-key map "p"  'p4-prev-depot-file)
 421     (define-key map "N" (lookup-key map "p"))
 422     map)
 423   "The key map to use for selecting opened files.")
 424
 425 (defvar p4-diff-map
 426   (let ((map (p4-make-derived-map p4-basic-map)))
 427     (define-key map "n"  'p4-goto-next-diff)
 428     (define-key map "p"  'p4-goto-prev-diff)
 429     (define-key map "N" (lookup-key map "p"))
 430     (define-key map "d"  'p4-next-depot-diff)
 431     (define-key map "u"  'p4-prev-depot-diff)
 432     map))
 433
 434 (defvar p4-print-rev-map
 435   (let ((map (p4-make-derived-map p4-basic-map)))
 436     (define-key map "n"  'p4-next-change-rev-line)
 437     (define-key map "p"  'p4-prev-change-rev-line)
 438     (define-key map "N" (lookup-key map "p"))
 439     (define-key map "l"  'p4-toggle-line-wrap)
 440     map)
 441   "The key map to use for browsing print-revs buffers.")
 442
 443 ;;; All functions start here.
 444
 445 ;; A generic function that we use to execute p4 commands
 446 (eval-and-compile
 447   (defun p4-exec-p4 (output-buffer args &optional clear-output-buffer)
 448     "Internal function called by various p4 commands.
 449 Executes p4 in the current buffer's current directory
 450 with output to a dedicated output buffer.
 451 If successful, adds the P4 menu to the current buffer.
 452 Does auto re-highlight management (whatever that is)."
 453     (save-excursion
 454       (if (eq major-mode 'dired-mode)
 455           (let ((dir (dired-current-directory)))
 456             (set-buffer output-buffer)
 457             (setq default-directory dir)))
 458       (if clear-output-buffer
 459           (progn
 460             (set-buffer output-buffer)
 461             (delete-region (point-min) (point-max))))
 462       (let ((result
 463              (apply 'call-process (p4-check-p4-executable) nil
 464                     output-buffer
 465                     nil                 ; update display?
 466                     "-d" default-directory  ;override "PWD" env var
 467                     args)))
 468         (p4-menu-add)
 469         (if (and p4-running-emacs
 470                  (boundp 'hilit-auto-rehighlight))
 471             (setq hilit-auto-rehighlight nil))
 472         result)))
 473   (defun p4-call-p4-here (&rest args)
 474     "Internal function called by various p4 commands.
 475 Executes p4 in the current buffer (generally a temp)."
 476     (apply 'call-process (p4-check-p4-executable) nil
 477            t
 478            nil                  ; update display?
 479            "-d" default-directory  ;override "PWD" env var
 480            args)))
 481
 482 (defun p4-push-window-config ()
 483   "Push the current window configuration on the `p4-window-config-stack'
 484 stack."
 485   (interactive)
 486   (setq p4-window-config-stack
 487         (cons (current-window-configuration)
 488               p4-window-config-stack))
 489   (while (> (length p4-window-config-stack) p4-window-config-stack-size)
 490     (setq p4-window-config-stack
 491           (reverse (cdr (reverse p4-window-config-stack))))))
 492
 493 (defun p4-pop-window-config (num)
 494   "Pop `num' elements from the `p4-window-config-stack' stack and use
 495 the last popped element to restore the window configuration."
 496   (interactive "p")
 497   (while (> num 0)
 498     (if (eq p4-window-config-stack nil)
 499         (error "window config stack empty"))
 500     (set-window-configuration (car p4-window-config-stack))
 501     (setq p4-window-config-stack (cdr p4-window-config-stack))
 502     (setq num (1- num)))
 503   (message "window config popped (stack size %d)"
 504            (length p4-window-config-stack)))
 505
 506
 507 ;; The menu definition is in the XEmacs format. Emacs parses and converts
 508 ;; this definition to its own menu creation commands.
 509
 510 (defalias 'p4-toggle-vc-mode-off 'p4-toggle-vc-mode)
 511 (defalias 'p4-toggle-vc-mode-on 'p4-toggle-vc-mode)
 512
 513 (eval-and-compile
 514   (defvar p4-menu-def
 515     '(["Specify Arguments..." universal-argument t]
 516       ["--" nil nil]
 517       ["Add Current to P4" p4-add
 518        (and (p4-buffer-file-name) (not p4-mode))]
 519       ["Check out/Edit"    p4-edit
 520        (and (p4-buffer-file-name-2) (or (not p4-mode) buffer-read-only))]
 521       ["Re-open"               p4-reopen
 522        (and (p4-buffer-file-name-2) (or (not p4-mode) (not buffer-read-only)))]
 523       ["Revert File"  p4-revert
 524        (and (p4-buffer-file-name-2) (or (not p4-mode) (not buffer-read-only)))]
 525       ["Delete File from Depot"  p4-delete
 526        (and (p4-buffer-file-name-2) (or (not p4-mode) buffer-read-only))]
 527       ["Rename Depot File" p4-rename
 528        (and (p4-buffer-file-name-2) (or (not p4-mode) buffer-read-only))]
 529       ["Submit Changes"  p4-submit t]
 530       ["--" nil nil]
 531       ["Sync/Get Files from Depot" p4-get t]
 532       ["--" nil nil]
 533       ["Show Opened Files"      p4-opened t]
 534       ["Filelog" p4-filelog (p4-buffer-file-name-2)]
 535       ["Changes" p4-changes t]
 536       ["Describe Change" p4-describe t]
 537       ["--" nil nil]
 538       ["Diff 2 Versions" p4-diff2 (p4-buffer-file-name-2)]
 539       ["Diff Current" p4-diff t]
 540       ["Diff All Opened Files" p4-diff-all-opened t]
 541       ["Diff Current with Ediff"   p4-ediff
 542        (and (p4-buffer-file-name) (not buffer-read-only) p4-mode)]
 543       ["Diff 2 Versions with Ediff"   p4-ediff2 (p4-buffer-file-name-2)]
 544       ["--" nil nil]
 545       ["Schedule Integrations" p4-integ t]
 546       ["Resolve Conflicts" p4-resolve t]
 547       ["--" nil nil]
 548       ["Print" p4-print (p4-buffer-file-name-2)]
 549       ["Print with Revision History" p4-blame
 550        (p4-buffer-file-name-2)]
 551       ["Find File using Depot Spec" p4-depot-find-file
 552        p4-do-find-file]
 553       ["--" nil nil]
 554       ["Edit a Branch Specification" p4-branch t]
 555       ["Edit a Label Specification" p4-label t]
 556       ["Edit a Client Specification" p4-client t]
 557       ["Edit a User Specification" p4-user t]
 558       ["--" nil nil]
 559       ["Show Version" p4-emacs-version t]
 560       ["Disable P4 VC Check"  p4-toggle-vc-mode-off
 561        p4-do-find-file]
 562       ["Enable P4 VC Check"      p4-toggle-vc-mode-on
 563        (not p4-do-find-file)]
 564       ["--" nil nil]
 565       ["Set P4 Config"  p4-set-client-config p4-do-find-file]
 566       ["Get Current P4 Config"  p4-get-client-config
 567        p4-do-find-file]
 568       ["--" nil nil]
 569       ["Set P4 Client"  p4-set-client-name p4-do-find-file]
 570       ["Get Current P4 Client"  p4-get-client-name
 571        p4-do-find-file]
 572       ["--" nil nil]
 573       ["Set P4 Server/Port"      p4-set-p4-port p4-do-find-file]
 574       ["Get Current P4 Server/Port"      p4-get-p4-port
 575        p4-do-find-file]
 576       ["--" nil nil]
 577       ["Set P4 Notification List"  p4-set-notify-list
 578        p4-mode]
 579       ["Get P4 Notification List"  p4-get-notify-list p4-notify]
 580       ["--" nil nil]
 581       ["Describe Key Bindings"  p4-describe-bindings t]
 582       ["Check for later versions of p4.el" p4-browse-web-page t]
 583       ["--" nil nil]
 584       ["Report Bug in p4.el"  p4-bug-report t])
 585     "The P4 menu definition")
 586
 587   (cond (p4-running-xemacs
 588          ;; Menu Support for XEmacs
 589          (require 'easymenu)
 590          (defun p4-mode-menu (modestr)
 591            (cons modestr p4-menu-def)))
 592
 593         (p4-running-emacs
 594          ;; Menu support for Emacs
 595          (or (lookup-key global-map [menu-bar])
 596              (define-key global-map [menu-bar] (make-sparse-keymap "menu-bar")))
 597          (defvar menu-bar-p4-menu (make-sparse-keymap "P4"))
 598          (setq menu-bar-final-items (cons 'p4-menu menu-bar-final-items))
 599          (define-key global-map [menu-bar p4-menu]
 600            (cons "P4" menu-bar-p4-menu))
 601          (let ((m (reverse p4-menu-def))
 602                (separator-number 0))
 603            (while m
 604              (let ((menu-text (elt (car m) 0))
 605                    (menu-action (elt (car m) 1))
 606                    (menu-pred (elt (car m) 2)))
 607                (if menu-action
 608                    (progn
 609                      (define-key menu-bar-p4-menu (vector menu-action)
 610                        (cons menu-text menu-action))
 611                      (put menu-action 'menu-enable menu-pred))
 612                  (define-key menu-bar-p4-menu
 613                    (vector (make-symbol
 614                             (concat "separator-"
 615                                     (int-to-string separator-number))))
 616                    '("--"))
 617                  (setq separator-number (1+ separator-number))))
 618              (setq m (cdr m))))))
 619
 620   (defun p4-depot-output (command &optional args)
 621     "Executes p4 command inside a buffer.
 622 Returns the buffer."
 623     (let ((buffer (generate-new-buffer p4-output-buffer-name)))
 624       (p4-exec-p4 buffer (cons command args) t)
 625       buffer))
 626
 627   (defun p4-check-p4-executable ()
 628     "Check if the `p4-executable' is nil, and if so, prompt the user for a
 629 valid `p4-executable'."
 630     (interactive)
 631     (if (not p4-executable)
 632         (call-interactively 'p4-set-p4-executable)
 633       p4-executable))
 634
 635   (defun p4-menu-add ()
 636     "To add the P4 menu bar button for files that are already not in
 637 the P4 depot or in the current client view.."
 638     (interactive)
 639     (cond (p4-running-xemacs
 640            (if (not (boundp 'p4-mode))
 641                (setq p4-mode nil))
 642            (easy-menu-add (p4-mode-menu "P4"))))
 643     t)
 644
 645   (defun p4-help-text (cmd text)
 646     (setq cmd nil)
 647     (if cmd
 648         (let ((buf (generate-new-buffer p4-output-buffer-name))
 649               (help-text ""))
 650           (if (= (p4-exec-p4 buf (list "help" cmd) t) 0)
 651               (setq help-text (save-excursion
 652                                 (set-buffer buf)
 653                                 (buffer-string))))
 654           (kill-buffer buf)
 655           (concat text help-text))
 656       text))
 657
 658   ;; To set the path to the p4 executable
 659   (defun p4-set-p4-executable (p4-exe-name)
 660     "Set the path to the correct P4 Executable.
 661
 662 To set this as a part of the .emacs, add the following to your .emacs:
 663
 664 \(load-library \"p4\"\)
 665 \(p4-set-p4-executable \"/my/path/to/p4\"\)
 666
 667 Argument P4-EXE-NAME The new value of the p4 executable, with full path."
 668     (interactive "fFull path to your P4 executable: " )
 669     (setq p4-executable p4-exe-name)
 670     p4-executable))
 671
 672 ;; The kill-buffer hook for p4.
 673 (defun p4-kill-buffer-hook ()
 674   "To Remove a file and its associated buffer from our global list of P4
 675 controlled files."
 676   (if p4-vc-check
 677       (p4-refresh-refresh-list (p4-buffer-file-name)
 678                                (buffer-name))))
 679
 680 (defmacro defp4cmd (fkn &rest all-args)
 681   (let ((args (car all-args))
 682         (help-cmd (cadr all-args))
 683         (help-txt (eval (cadr (cdr all-args))))
 684         (body (cdr (cddr all-args))))
 685     `(defalias ',fkn
 686        ,(append (list 'lambda args
 687                       (p4-help-text help-cmd help-txt))
 688                 body))))
 689
 690 (defun p4-noinput-buffer-action (cmd
 691                                  do-revert
 692                                  show-output
 693                                  &optional arguments preserve-buffer)
 694   "Internal function called by various p4 commands."
 695   (save-excursion
 696     (save-excursion
 697       (if (not preserve-buffer)
 698           (progn
 699             (get-buffer-create p4-output-buffer-name);; We do these two lines
 700             (kill-buffer p4-output-buffer-name)))    ;; to ensure no duplicates
 701       (p4-exec-p4 (get-buffer-create p4-output-buffer-name)
 702                   (append (list cmd) arguments)
 703                   t))
 704     (p4-partial-cache-cleanup cmd)
 705     (if show-output
 706         (if (and
 707              (eq show-output 's)
 708              (= (save-excursion
 709                   (set-buffer p4-output-buffer-name)
 710                   (count-lines (point-min) (point-max)))
 711                 1)
 712              (not (save-excursion
 713                     (set-buffer p4-output-buffer-name)
 714                     (goto-char (point-min))
 715                     (looking-at "==== "))))
 716             (save-excursion
 717               (set-buffer p4-output-buffer-name)
 718               (message (buffer-substring (point-min)
 719                                          (save-excursion
 720                                            (goto-char (point-min))
 721                                            (end-of-line)
 722                                            (point)))))
 723           (p4-push-window-config)
 724           (if (not (one-window-p))
 725               (delete-other-windows))
 726           (display-buffer p4-output-buffer-name t))))
 727   (if (and do-revert (p4-buffer-file-name))
 728       (revert-buffer t t)))
 729
 730 ;; The p4 edit command
 731 (defp4cmd p4-edit (show-output)
 732   "edit" "To open the current depot file for edit, type \\[p4-edit].\n"
 733   (interactive (list p4-verbose))
 734   (let ((args (p4-buffer-file-name))
 735         refresh-after)
 736     (if (or current-prefix-arg (not args))
 737         (progn
 738           (setq args (if (p4-buffer-file-name-2)
 739                          (p4-buffer-file-name-2)
 740                        ""))
 741           (setq args (p4-make-list-from-string
 742                       (p4-read-arg-string "p4 edit: " (cons args 0))))
 743           (setq refresh-after t))
 744       (setq args (list args)))
 745     (p4-noinput-buffer-action "edit" t (and show-output 's) args)
 746     (if refresh-after
 747         (p4-refresh-files-in-buffers)))
 748   (p4-check-mode)
 749   (p4-update-opened-list))
 750
 751 ;; The p4 reopen command
 752 (defp4cmd p4-reopen (show-output)
 753   "reopen"
 754   "To change the type or changelist number of an opened file, type \\[p4-reopen].
 755
 756 Argument SHOW-OUTPUT displays the *P4 Output* buffer on executing the
 757 command if t.\n"
 758
 759   (interactive (list p4-verbose))
 760   (let ((args (if (p4-buffer-file-name-2)
 761                   (p4-buffer-file-name-2)
 762                 "")))
 763     (setq args (p4-make-list-from-string
 764                 (p4-read-arg-string "p4 reopen: " (cons args 0))))
 765     (p4-noinput-buffer-action "reopen" t (and show-output 's) args))
 766   (p4-check-mode)
 767   (p4-update-opened-list))
 768
 769 ;; The p4 revert command
 770 (defp4cmd p4-revert (show-output)
 771   "revert" "To revert all change in the current file, type \\[p4-revert].\n"
 772   (interactive (list p4-verbose))
 773   (let ((args (p4-buffer-file-name))
 774         refresh-after)
 775     (if (or current-prefix-arg (not args))
 776         (progn
 777           (setq args (if (p4-buffer-file-name-2)
 778                          (p4-buffer-file-name-2)
 779                        ""))
 780           (setq args (p4-make-list-from-string
 781                       (p4-read-arg-string "p4 revert: " args)))
 782           (setq refresh-after t))
 783       (setq args (list args)))
 784     (if (yes-or-no-p "Really revert changes? ")
 785         (progn
 786           (p4-noinput-buffer-action "revert" t (and show-output 's) args)
 787           (if refresh-after
 788               (progn
 789                 (p4-refresh-files-in-buffers)
 790                 (p4-check-mode-all-buffers))
 791             (p4-check-mode))
 792           (p4-update-opened-list)))))
 793
 794 ;; The p4 lock command
 795 (defp4cmd p4-lock ()
 796   "lock" "To lock an opened file against changelist submission, type \\[p4-lock].\n"
 797   (interactive)
 798   (let ((args (list (p4-buffer-file-name-2))))
 799     (if (or current-prefix-arg (not (p4-buffer-file-name-2)))
 800         (setq args (p4-make-list-from-string
 801                     (p4-read-arg-string "p4 lock: "
 802                                         (p4-buffer-file-name-2)))))
 803     (p4-noinput-buffer-action "lock" t 's args)
 804     (p4-update-opened-list)))
 805
 806 ;; The p4 unlock command
 807 (defp4cmd p4-unlock ()
 808   "unlock" "To release a locked file but leave open, type \\[p4-unlock].\n"
 809   (interactive)
 810   (let ((args (list (p4-buffer-file-name-2))))
 811     (if (or current-prefix-arg (not (p4-buffer-file-name-2)))
 812         (setq args (p4-make-list-from-string
 813                     (p4-read-arg-string "p4 unlock: "
 814                                         (p4-buffer-file-name-2)))))
 815     (p4-noinput-buffer-action "unlock" t 's args)
 816     (p4-update-opened-list)))
 817
 818 ;; The p4 diff command
 819 (defp4cmd p4-diff ()
 820   "diff" "To diff the current file and topmost depot version, type \\[p4-diff].\n"
 821   (interactive)
 822   (let ((args (p4-make-list-from-string p4-default-diff-options)))
 823     (if (p4-buffer-file-name-2)
 824         (setq args (append args
 825                            (list (p4-buffer-file-name-2)))))
 826     (if current-prefix-arg
 827         (setq args (p4-make-list-from-string
 828                     (p4-read-arg-string "p4 diff: " p4-default-diff-options))))
 829     (p4-noinput-buffer-action "diff" nil 's args)
 830     (p4-activate-diff-buffer "*P4 diff*")))
 831
 832 (defun p4-diff-all-opened ()
 833   (interactive)
 834   (p4-noinput-buffer-action "diff" nil 's
 835                             (p4-make-list-from-string p4-default-diff-options))
 836   (p4-activate-diff-buffer "*P4 diff*"))
 837
 838
 839 (defun p4-get-file-rev (default-name rev)
 840   (if (string-match "^\\([0-9]+\\|none\\|head\\|have\\)$" rev)
 841       (setq rev (concat "#" rev)))
 842   (cond ((string-match "^[#@]" rev)
 843          (concat default-name rev))
 844         ((string= "" rev)
 845          default-name)
 846         (t
 847          rev)))
 848
 849 ;; The p4 diff2 command
 850 (defp4cmd p4-diff2 (version1 version2)
 851   "diff2" "Display diff of two depot files.
 852
 853 When visiting a depot file, type \\[p4-diff2] and enter the versions.\n"
 854   (interactive
 855    (let ((rev (get-char-property (point) 'rev)))
 856      (if (and (not rev) (p4-buffer-file-name-2))
 857          (let ((rev-num 0))
 858            (setq rev (p4-is-vc nil (p4-buffer-file-name-2)))
 859            (if rev
 860                (setq rev-num (string-to-number rev)))
 861            (if (> rev-num 1)
 862                (setq rev (number-to-string (1- rev-num)))
 863              (setq rev nil))))
 864      (list (p4-read-arg-string "First Depot File or Version# to diff: " rev)
 865            (p4-read-arg-string "Second Depot File or Version# to diff: "))))
 866   (let (diff-version1
 867         diff-version2
 868         (diff-options (p4-make-list-from-string p4-default-diff-options)))
 869     (if current-prefix-arg
 870         (setq diff-options (p4-make-list-from-string
 871                             (p4-read-arg-string "Optional Args: "
 872                                                 p4-default-diff-options))))
 873     ;; try to find out if this is a revision number, or a depot file
 874     (setq diff-version1 (p4-get-file-rev (p4-buffer-file-name-2) version1))
 875     (setq diff-version2 (p4-get-file-rev (p4-buffer-file-name-2) version2))
 876
 877     (p4-noinput-buffer-action "diff2" nil t
 878                               (append diff-options
 879                                       (list diff-version1
 880                                             diff-version2)))
 881     (p4-activate-diff-buffer "*P4 diff2*")))
 882
 883 ;; p4-ediff for all those who diff using ediff
 884 (defun p4-ediff ()
 885   "Use ediff to compare file with its original client version."
 886   (interactive)
 887   (require 'ediff)
 888   (if current-prefix-arg
 889       (call-interactively 'p4-ediff2)
 890     (progn
 891       (p4-noinput-buffer-action "print" nil nil
 892                                 (list "-q"
 893                                       (concat (p4-buffer-file-name) "#have")))
 894       (let ((local (current-buffer))
 895             (depot (get-buffer-create p4-output-buffer-name)))
 896         (ediff-buffers local
 897                        depot
 898                        `((lambda ()
 899                            (make-local-variable 'ediff-cleanup-hook)
 900                            (setq ediff-cleanup-hook
 901                                  (cons (lambda ()
 902                                          (kill-buffer ,depot)
 903                                          (p4-menu-add))
 904                                        ediff-cleanup-hook)))))))))
 905
 906 (defp4cmd p4-ediff2 (version1 version2)
 907   "ediff2" "Use ediff to display two versions of a depot file.
 908
 909 When visiting a depot file, type \\[p4-ediff2] and enter the versions.\n"
 910   (interactive
 911    (let ((rev (get-char-property (point) 'rev)))
 912      (if (and (not rev) (p4-buffer-file-name-2))
 913          (let ((rev-num 0))
 914            (setq rev (p4-is-vc nil (p4-buffer-file-name-2)))
 915            (if rev
 916                (setq rev-num (string-to-number rev)))
 917            (if (> rev-num 1)
 918                (setq rev (number-to-string (1- rev-num)))
 919              (setq rev nil))))
 920      (list (p4-read-arg-string "First Depot File or Version# to diff: " rev)
 921            (p4-read-arg-string "Second Depot File or Version# to diff: "))))
 922   (let* ((file-name (p4-buffer-file-name-2))
 923          (basename (file-name-nondirectory file-name))
 924          (bufname1 (concat "*P4 ediff " basename "#" version1  "*"))
 925          (bufname2 (concat "*P4 ediff " basename "#" version2  "*"))
 926          (diff-version1 (p4-get-file-rev file-name version1))
 927          (diff-version2 (p4-get-file-rev file-name version2)))
 928     (p4-noinput-buffer-action "print" nil nil (list "-q" diff-version1))
 929     (set-buffer p4-output-buffer-name)
 930     (rename-buffer bufname1 t)
 931     (p4-noinput-buffer-action "print" nil nil (list "-q" diff-version2))
 932     (set-buffer p4-output-buffer-name)
 933     (rename-buffer bufname2 t)
 934     (let ((buffer-version-1 (get-buffer-create bufname1))
 935           (buffer-version-2 (get-buffer-create bufname2)))
 936       (ediff-buffers buffer-version-1
 937                      buffer-version-2
 938                      `((lambda ()
 939                          (make-local-variable 'ediff-cleanup-hook)
 940                          (setq ediff-cleanup-hook
 941                                (cons (lambda ()
 942                                        (kill-buffer ,buffer-version-1)
 943                                        (kill-buffer ,buffer-version-2)
 944                                        (p4-menu-add))
 945                                      ediff-cleanup-hook))))))))
 946 ;; The p4 add command
 947 (defp4cmd p4-add ()
 948   "add" "To add the current file to the depot, type \\[p4-add].\n"
 949   (interactive)
 950   (let ((args (p4-buffer-file-name))
 951         refresh-after)
 952     (if (or current-prefix-arg (not args))
 953         (progn
 954           (setq args (if (p4-buffer-file-name-2)
 955                          (p4-buffer-file-name-2)
 956                        ""))
 957           (setq args (p4-make-list-from-string
 958                       (p4-read-arg-string "p4 add: " (cons args 0))))
 959           (setq refresh-after t))
 960       (setq args (list args)))
 961     (p4-noinput-buffer-action "add" nil 's args)
 962     (if refresh-after
 963         (p4-check-mode-all-buffers)
 964       (p4-check-mode)))
 965   (p4-update-opened-list))
 966
 967
 968 ;; The p4 delete command
 969 (defp4cmd p4-delete ()
 970   "delete" "To delete the current file from the depot, type \\[p4-delete].\n"
 971   (interactive)
 972   (let ((args (p4-buffer-file-name)))
 973     (if (or current-prefix-arg (not args))
 974         (setq args (p4-make-list-from-string
 975                     (p4-read-arg-string "p4 delete: "
 976                                         (p4-buffer-file-name-2))))
 977       (setq args (list args)))
 978     (if (yes-or-no-p "Really delete from depot? ")
 979         (p4-noinput-buffer-action "delete" nil 's args)))
 980   (p4-check-mode)
 981   (p4-update-opened-list))
 982
 983 ;; The p4 filelog command
 984 (defp4cmd p4-filelog ()
 985   "filelog"
 986   "To view a history of the change made to the current file, type \\[p4-filelog].\n"
 987   (interactive)
 988   (let ((file-name (p4-buffer-file-name-2)))
 989     (if (or current-prefix-arg (not file-name))
 990         (setq file-name (p4-make-list-from-string
 991                          (p4-read-arg-string "p4 filelog: " file-name)))
 992       (setq file-name (list file-name)))
 993     (p4-file-change-log "filelog" file-name)))
 994
 995 (defun p4-set-extent-properties (start end prop-list)
 996   (cond (p4-running-xemacs
 997          (let ((ext (make-extent start end)))
 998            (while prop-list
 999              (set-extent-property ext (caar prop-list) (cdar prop-list))
1000              (setq prop-list (cdr prop-list)))))
1001         (p4-running-emacs
1002          (let ((ext (make-overlay start end)))
1003            (while prop-list
1004              (overlay-put ext (caar prop-list) (cdar prop-list))
1005              (setq prop-list (cdr prop-list)))))))
1006
1007 (defun p4-create-active-link (start end prop-list)
1008   (p4-set-extent-properties start end
1009                             (append (list (cons 'face 'bold)
1010                                           (cons 'mouse-face 'highlight))
1011                                     prop-list)))
1012
1013 (defun p4-move-buffer-point-to-top (buf-name)
1014   (if (get-buffer-window buf-name)
1015       (save-selected-window
1016         (select-window (get-buffer-window buf-name))
1017         (goto-char (point-min)))))
1018
1019 (defun p4-file-change-log (cmd file-list-spec)
1020   (let ((p4-filelog-buffer
1021          (concat "*P4 " cmd ": "
1022                  (p4-list-to-string file-list-spec) "*")))
1023     (p4-noinput-buffer-action cmd nil t (cons "-l" file-list-spec))
1024     (p4-activate-file-change-log-buffer p4-filelog-buffer)))
1025
1026 (defun p4-activate-file-change-log-buffer (bufname)
1027   (let (p4-cur-rev p4-cur-change p4-cur-action
1028         p4-cur-user p4-cur-client)
1029     (p4-activate-print-buffer bufname nil)
1030     (set-buffer bufname)
1031     (setq buffer-read-only nil)
1032     (goto-char (point-min))
1033     (while (re-search-forward (concat
1034                                "^\\(\\.\\.\\. #\\([0-9]+\\) \\)?[Cc]hange "
1035                                "\\([0-9]+\\) \\([a-z]+\\)?.*on.*by "
1036                                "\\([^ @]+\\)@\\([^ \n]+\\).*\n"
1037                                "\\(\\(\\([ \t].*\\)?\n\\)*\\)") nil t)
1038       (let ((rev-match 2)
1039             (ch-match 3)
1040             (act-match 4)
1041             (user-match 5)
1042             (cl-match 6)
1043             (desc-match 7))
1044         (setq p4-cur-rev (match-string rev-match))
1045         (setq p4-cur-change (match-string ch-match))
1046         (setq p4-cur-action (match-string act-match))
1047         (setq p4-cur-user (match-string user-match))
1048         (setq p4-cur-client (match-string cl-match))
1049
1050         (if (match-beginning rev-match)
1051             (p4-create-active-link (match-beginning rev-match)
1052                                    (match-end rev-match)
1053                                    (list (cons 'rev p4-cur-rev))))
1054         (p4-create-active-link (match-beginning ch-match)
1055                                (match-end ch-match)
1056                                (list (cons 'change p4-cur-change)))
1057         (if (match-beginning act-match)
1058             (p4-create-active-link (match-beginning act-match)
1059                                    (match-end act-match)
1060                                    (list (cons 'action p4-cur-action)
1061                                          (cons 'rev p4-cur-rev))))
1062         (p4-create-active-link (match-beginning user-match)
1063                                (match-end user-match)
1064                                (list (cons 'user p4-cur-user)))
1065         (p4-create-active-link (match-beginning cl-match)
1066                                (match-end cl-match)
1067                                (list (cons 'client p4-cur-client)))
1068         (p4-set-extent-properties (match-beginning desc-match)
1069                                   (match-end desc-match)
1070                                   (list (cons 'invisible t)
1071                                         (cons 'isearch-open-invisible t)))))
1072     (p4-find-change-numbers bufname (point-min) (point-max))
1073     (use-local-map p4-filelog-map)
1074     (setq buffer-invisibility-spec (list))
1075     (setq buffer-read-only t)
1076     (p4-move-buffer-point-to-top bufname)))
1077
1078 ;; Scan specified region for references to change numbers
1079 ;; and make the change numbers clickable.
1080 (defun p4-find-change-numbers (buffer start end)
1081   (save-excursion
1082     (set-buffer buffer)
1083     (goto-char start)
1084     (while (re-search-forward "\\(changes?\\|submit\\|p4\\)[:#]?[ \t\n]+" end t)
1085       (while (looking-at
1086               (concat "\\([#@]\\|number\\|no\\.\\|\\)[ \t\n]*"
1087                       "\\([0-9]+\\)[-, \t\n]*"
1088                       "\\(and/or\\|and\\|&\\|or\\|\\)[ \t\n]*"))
1089         (let ((ch-start (match-beginning 2))
1090               (ch-end (match-end 2))
1091               (ch-str (match-string 2))
1092               (next (match-end 0)))
1093           (set-text-properties 0 (length ch-str) nil ch-str)
1094           (p4-create-active-link ch-start ch-end (list (cons 'change ch-str)))
1095           (goto-char next))))))
1096
1097 ;; The p4 files command
1098 (defp4cmd p4-files ()
1099   "files" "List files in the depot. Type, \\[p4-files].\n"
1100   (interactive)
1101   (let ((args (p4-buffer-file-name-2)))
1102     (if (or current-prefix-arg (not args))
1103         (setq args (p4-make-list-from-string
1104                     (p4-read-arg-string "p4 files: " (p4-buffer-file-name-2))))
1105       (setq args (list args)))
1106     (p4-noinput-buffer-action "files" nil t args)
1107     (save-excursion
1108       (set-buffer p4-output-buffer-name)
1109       (p4-find-change-numbers p4-output-buffer-name (point-min) (point-max)))
1110     (p4-make-depot-list-buffer
1111      (concat "*P4 Files: (" (p4-current-client) ") " (car args) "*"))))
1112
1113
1114 (defvar p4-server-version-cache nil)
1115
1116 (defun p4-get-server-version ()
1117   "To get the version number of the p4 server."
1118   (let ((p4-port (p4-current-server-port))
1119         ser-ver pmin)
1120     (setq ser-ver (cdr (assoc p4-port p4-server-version-cache)))
1121     (if (not ser-ver)
1122         (save-excursion
1123           (get-buffer-create p4-output-buffer-name)
1124           (set-buffer p4-output-buffer-name)
1125           (goto-char (point-max))
1126           (setq pmin (point))
1127           (if (zerop (p4-call-p4-here "info"))
1128               (progn
1129                 (goto-char pmin)
1130                 (re-search-forward
1131                  "^Server version: .*\/.*\/\\(\\([0-9]+\\)\.[0-9]+\\)\/.*(.*)$")
1132                 (setq ser-ver (string-to-number (match-string 2)))
1133                 (setq p4-server-version-cache (cons (cons p4-port ser-ver)
1134                                                     p4-server-version-cache))
1135                 (delete-region pmin (point-max))))))
1136     ser-ver))
1137
1138 (defun p4-get-client-root (client-name)
1139   "To get the current value of Client's root type \\[p4-get-client-root].
1140    This can be used by any other macro that requires this value."
1141   (let (p4-client-root pmin)
1142     (save-excursion
1143       (get-buffer-create p4-output-buffer-name)
1144       (set-buffer p4-output-buffer-name)
1145       (goto-char (point-max))
1146       (setq pmin (point))
1147       (if (zerop (p4-call-p4-here "client" "-o" client-name))
1148           (progn
1149             (goto-char pmin)
1150             (re-search-forward "^Root:[ \t]+\\(.*\\)$")
1151             (setq p4-client-root (p4-canonize-client-root (match-string 1)))
1152             (delete-region pmin (point-max)))))
1153     p4-client-root))
1154
1155 (defun p4-canonize-client-root (p4-client-root)
1156   "Canonizes client root"
1157   (let ((len (length p4-client-root)))
1158     ;; For Windows, since the client root may be terminated with
1159     ;; a \ as in c:\ or drive:\foo\bar\, we need to strip the
1160     ;; trailing \ .
1161     (if (and (p4-windows-os)
1162              (> len 1)
1163              (equal (substring p4-client-root (1- len) len) "\\"))
1164         (setq p4-client-root (substring p4-client-root 0 (1- len))))
1165     p4-client-root))
1166
1167 (defun p4-map-depot-files (file-list)
1168   "Map a list of files in the depot on the current client.
1169 Return a list of pairs, where each pair consists of a depot
1170 name and a client name."
1171   (let (file-map)
1172     (while file-list
1173       (let (sub-list (arg-len 0) elt)
1174         (while (and file-list (< arg-len p4-exec-arg-len-max))
1175           (setq elt (car file-list))
1176           (setq file-list (cdr file-list))
1177           (setq sub-list (cons elt sub-list))
1178           (setq arg-len (+ arg-len (length elt) 1)))
1179         (setq file-map (append file-map
1180                                (p4-map-depot-files-int sub-list)))))
1181     file-map))
1182
1183 (defun p4-map-depot-files-int (file-list)
1184   (let* ((current-client (p4-current-client))
1185          (client-root (p4-get-client-root current-client))
1186          (re-current-client (regexp-quote current-client))
1187          (re-client-root (regexp-quote client-root))
1188          files pmin)
1189     (save-excursion
1190       (get-buffer-create p4-output-buffer-name)
1191       (set-buffer p4-output-buffer-name)
1192       (goto-char (point-max))
1193       (setq pmin (point))
1194       (insert "\n")
1195       (apply 'p4-call-p4-here "where" file-list)
1196       (goto-char pmin)
1197       (if (< (p4-get-server-version) 98)
1198           (while (re-search-forward
1199                   (concat "^\\([^\n]+\\) //" re-current-client
1200                           "\\(.*\\)$") nil t)
1201             (setq files (cons
1202                          (cons
1203                           (match-string 1)
1204                           (concat client-root (match-string 2)))
1205                          files)))
1206         (while (re-search-forward
1207                 (concat "^\\([^\n]+\\) //" re-current-client
1208                         "\\([^\n]+\\) \\(" re-client-root ".*\\)$") nil t)
1209           (setq files (cons
1210                        (cons
1211                         (match-string 1) (match-string 3)) files))))
1212       (delete-region pmin (point-max)))
1213     files))
1214
1215 (make-face 'p4-depot-unmapped-face)
1216 (set-face-foreground 'p4-depot-unmapped-face "grey30")
1217
1218 (make-face 'p4-depot-deleted-face)
1219 (set-face-foreground 'p4-depot-deleted-face "red")
1220
1221 (make-face 'p4-depot-added-face)
1222 (set-face-foreground 'p4-depot-added-face "blue")
1223
1224 (make-face 'p4-depot-branch-op-face)
1225 (set-face-foreground 'p4-depot-branch-op-face "blue4")
1226
1227 (defun p4-make-depot-list-buffer (bufname &optional print-buffer)
1228   "Take the p4-output-buffer-name buffer, rename it to bufname, and
1229 make all depot file names active, so that clicking them opens
1230 the corresponding client file."
1231   (let (args files depot-regexp)
1232     (set-buffer p4-output-buffer-name)
1233     (goto-char (point-min))
1234     (setq depot-regexp
1235           (if print-buffer
1236               "\\(^\\)\\(//[^/@# ][^/@#]*/[^@#]+\\)#[0-9]+ - "
1237             "^\\(\\.\\.\\. [^/\n]*\\|==== \\)?\\(//[^/@# ][^/@#]*/[^#\n]*\\)"))
1238     (while (re-search-forward depot-regexp nil t)
1239       (setq args (cons (match-string 2) args)))
1240     (setq files (p4-map-depot-files args))
1241     (get-buffer-create bufname);; We do these two lines
1242     (kill-buffer bufname);; to ensure no duplicates
1243     (set-buffer p4-output-buffer-name)
1244     (rename-buffer bufname t)
1245     (goto-char (point-min))
1246     (while (re-search-forward depot-regexp nil t)
1247       (let ((p4-client-file (cdr (assoc (match-string 2) files)))
1248             (p4-depot-file (match-string 2))
1249             (start (match-beginning 2))
1250             (end (match-end 2))
1251             (branching-op-p (and (match-string 1)
1252                                  (string-match "\\.\\.\\. \\.\\.\\..*"
1253                                                (match-string 1))))
1254             prop-list)
1255         (if (and p4-client-file
1256                  (file-readable-p p4-client-file))
1257             (setq prop-list (list (cons 'link-client-name
1258                                         p4-client-file)))
1259           (setq prop-list (list (cons 'link-depot-name
1260                                       p4-depot-file))))
1261         ;; some kind of operation related to branching/integration
1262         (if branching-op-p
1263             (setq prop-list (append (list
1264                                      (cons 'history-for p4-depot-file)
1265                                      (cons 'face
1266                                            'p4-depot-branch-op-face))
1267                                     prop-list)))
1268         (cond
1269          ((not p4-client-file)
1270           (p4-set-extent-properties
1271            start end
1272            (append (list (cons 'face 'p4-depot-unmapped-face))
1273                    prop-list)))
1274          ((save-excursion
1275             (goto-char end)
1276             (looking-at ".* deleted?[ \n]"))
1277           (p4-set-extent-properties
1278            start end
1279            (append (list (cons 'face 'p4-depot-deleted-face))
1280                    prop-list)))
1281          ((save-excursion
1282             (goto-char end)
1283             (looking-at ".* \\(add\\|branch\\)\\(ed\\)?[ \n]"))
1284           (p4-create-active-link
1285            start end
1286            (append (list (cons 'face 'p4-depot-added-face))
1287                    prop-list)))
1288          (t
1289           (p4-create-active-link start end prop-list)))))
1290     (use-local-map p4-opened-map)
1291     (setq buffer-read-only t)
1292     (p4-move-buffer-point-to-top bufname)))
1293
1294 ;; The p4 print command
1295 (defp4cmd p4-print ()
1296   "print" "To print a depot file to a buffer, type \\[p4-print].\n"
1297   (interactive)
1298   (let ((arg-string (p4-buffer-file-name-2))
1299         (rev (get-char-property (point) 'rev))
1300         (change (get-char-property (point) 'change)))
1301     (cond (rev
1302            (setq arg-string (concat arg-string "#" rev)))
1303           (change
1304            (setq arg-string (concat arg-string "@" change))))
1305     (if (or current-prefix-arg (not arg-string))
1306         (setq arg-string (p4-make-list-from-string
1307                           (p4-read-arg-string "p4 print: " arg-string)))
1308       (setq arg-string (list arg-string)))
1309     (p4-noinput-buffer-action "print" nil t arg-string)
1310     (p4-activate-print-buffer "*P4 print*" t)))
1311
1312 ;; Insert text in a buffer, but make sure that the inserted text doesn't
1313 ;; inherit any properties from surrounding text. This is needed for xemacs
1314 ;; because the insert function makes the inserted text inherit properties.
1315 (defun p4-insert-no-properties (str)
1316   (let ((start (point))
1317         end)
1318     (insert str)
1319     (setq end (point))
1320     (set-text-properties start end nil)))
1321
1322 (defun p4-font-lock-buffer (buf-name)
1323   (save-excursion
1324     (let (file-name (first-line ""))
1325       (set-buffer buf-name)
1326       (goto-char (point-min))
1327       (if (looking-at "^//[^#@]+/\\([^/#@]+\\)")
1328           (progn
1329             (setq file-name (match-string 1))
1330             (forward-line 1)
1331             (setq first-line (buffer-substring (point-min) (point)))
1332             (delete-region (point-min) (point))))
1333       (setq buffer-file-name file-name)
1334       (set-auto-mode)
1335       (setq buffer-file-name nil)
1336       (condition-case nil
1337           (font-lock-fontify-buffer)
1338         (error nil))
1339       (fundamental-mode)
1340       (if (and p4-running-emacs
1341                (boundp 'hilit-auto-rehighlight))
1342           (setq hilit-auto-rehighlight nil))
1343       (goto-char (point-min))
1344       (p4-insert-no-properties first-line))))
1345
1346 (defun p4-activate-print-buffer (buffer-name print-buffer)
1347   (if print-buffer
1348       (p4-font-lock-buffer p4-output-buffer-name))
1349   (p4-make-depot-list-buffer buffer-name print-buffer)
1350   (let ((depot-regexp
1351          (if print-buffer
1352              "^\\(//[^/@# ][^/@#]*/\\)[^@#]+#[0-9]+ - "
1353            "^\\(//[^/@# ][^/@#]*/\\)")))
1354     (save-excursion
1355       (set-buffer buffer-name)
1356       (setq buffer-read-only nil)
1357       (goto-char (point-min))
1358       (while (re-search-forward depot-regexp nil t)
1359         (let ((link-client-name (get-char-property (match-end 1)
1360                                                    'link-client-name))
1361               (link-depot-name (get-char-property (match-end 1)
1362                                                   'link-depot-name))
1363               (start (match-beginning 1))
1364               (end (point-max)))
1365           (save-excursion
1366             (if (re-search-forward depot-regexp nil t)
1367                 (setq end (match-beginning 1))))
1368           (if link-client-name
1369               (p4-set-extent-properties start end
1370                                         (list (cons 'block-client-name
1371                                                     link-client-name))))
1372           (if link-depot-name
1373               (p4-set-extent-properties start end
1374                                         (list (cons 'block-depot-name
1375                                                     link-depot-name))))))
1376       (setq buffer-read-only t))))
1377
1378 (defconst p4-blame-change-regex
1379   (concat "^\\.\\.\\. #"     "\\([0-9]+\\)"   ;; revision
1380           "\\s-+change\\s-+" "\\([0-9]+\\)"   ;; change
1381           "\\s-+"            "\\([^ \t]+\\)"  ;; type
1382           "\\s-+on\\s-+"     "\\([^ \t]+\\)"  ;; date
1383           "\\s-+by\\s-+"     "\\([^ \t]+\\)"  ;; author
1384           "@"))
1385
1386 (defconst p4-blame-branch-regex
1387   "^\\.\\.\\. \\.\\.\\. branch from \\(//[^#]*\\)#")
1388
1389 (defconst p4-blame-revision-regex
1390   (concat "^\\([0-9]+\\),?"
1391           "\\([0-9]*\\)"
1392           "\\([acd]\\)"
1393           "\\([0-9]+\\),?"
1394           "\\([0-9]*\\)"))
1395
1396 (defconst p4-blame-index-regex
1397   (concat " *\\([0-9]+\\)"               ;; change
1398           " *\\([0-9]+\\)"               ;; revision
1399           " *\\([0-9]+/[0-9]+/[0-9]+\\)" ;; date
1400           "\\s-+\\([^:]*\\)"             ;; author
1401           ":"))
1402
1403 (defconst P4-REV  0)
1404 (defconst P4-DATE 1)
1405 (defconst P4-AUTH 2)
1406 (defconst P4-FILE 3)
1407
1408 (defun p4-blame ()
1409   "To Print a depot file with revision history to a buffer,
1410 type \\[p4-blame]"
1411   (interactive)
1412   (let ((arg-string (p4-buffer-file-name-2))
1413         (rev (get-char-property (point) 'rev))
1414         (change (get-char-property (point) 'change)))
1415     (cond (rev
1416            (setq arg-string (concat arg-string "#" rev)))
1417           (change
1418            (setq arg-string (concat arg-string "@" change))))
1419     (if (or current-prefix-arg (not arg-string))
1420         (setq arg-string (p4-read-arg-string "p4 print-revs: " arg-string)))
1421     (p4-blame-int arg-string)))
1422
1423 (defalias 'p4-print-with-rev-history 'p4-blame)
1424
1425 (defun p4-blame-int (file-spec)
1426   (get-buffer-create p4-output-buffer-name);; We do these two lines
1427   (kill-buffer p4-output-buffer-name)      ;; to ensure no duplicates
1428   (let ((file-name file-spec)
1429         (buffer (get-buffer-create p4-output-buffer-name))
1430         head-name  ;; file spec of the head revision for this blame assignment
1431         branch-p   ;; have we tracked into a branch?
1432         cur-file   ;; file name of the current branch during blame assignment
1433         change ch-alist fullname head-rev headseen)
1434
1435     ;; we asked for blame constrained by a change number
1436     (if (string-match "\\(.*\\)@\\([0-9]+\\)" file-spec)
1437         (progn
1438           (setq file-name (match-string 1 file-spec))
1439           (setq change (string-to-int (match-string 2 file-spec)))))
1440
1441     ;; we asked for blame constrained by a revision
1442     (if (string-match "\\(.*\\)#\\([0-9]+\\)" file-spec)
1443         (progn
1444           (setq file-name (match-string 1 file-spec))
1445           (setq head-rev (string-to-int (match-string 2 file-spec)))))
1446
1447     ;; make sure the filespec is unambiguous
1448     (p4-exec-p4 buffer (list "files" file-name) t)
1449     (save-excursion
1450       (set-buffer buffer)
1451       (if (> (count-lines (point-min) (point-max)) 1)
1452           (error "File pattern maps to more than one file.")))
1453
1454     ;; get the file change history:
1455     (p4-exec-p4 buffer (list "filelog" "-i" file-spec) t)
1456     (setq fullname (p4-read-depot-output buffer)
1457           cur-file  fullname
1458           head-name fullname)
1459
1460     ;; parse the history:
1461     (save-excursion
1462       (set-buffer buffer)
1463       (goto-char (point-min))
1464       (while (< (point) (point-max))
1465
1466         ;; record the current file name (and the head file name,
1467         ;; if we have not yet seen one):
1468         (if (looking-at "^\\(//.*\\)$")
1469             (setq cur-file (match-string 1)))
1470
1471         ;; a non-branch change:
1472         (if (looking-at p4-blame-change-regex)
1473             (let ((rev (string-to-int (match-string 1)))
1474                   (ch (string-to-int (match-string 2)))
1475                   (op (match-string 3))
1476                   (date (match-string 4))
1477                   (author (match-string 5)))
1478               (cond
1479                ;; after the change constraint, OR
1480                ;; after the revision constraint _for this file_
1481                ;;   [remember, branches complicate this]:
1482                ((or (and change   (< change ch))
1483                     (and head-rev (< head-rev rev)
1484                          (string= head-name cur-file))) nil)
1485
1486                ;; file has been deleted, can't assign blame:
1487                ((string= op "delete")
1488                 (if (not headseen) (goto-char (point-max))))
1489
1490                ;; OK, we actually want to look at this one:
1491                (t
1492                 (setq ch-alist
1493                       (cons
1494                        (cons ch (list rev date author cur-file)) ch-alist))
1495                 (if (not head-rev) (setq head-rev rev))
1496                 (setq headseen t)) ))
1497
1498           ;; not if we have entered a branch (this used to be used, isn't
1499           ;; right now - maybe again later:
1500           (if (and headseen (looking-at p4-blame-branch-regex))
1501               (setq branch-p t)) )
1502         (forward-line)))
1503
1504     (if (< (length ch-alist) 1)
1505         (error "Head revision not available"))
1506
1507     (let ((base-ch (int-to-string (caar ch-alist)))
1508           (ch-buffer (get-buffer-create "p4-ch-buf"))
1509           (tmp-alst (copy-alist ch-alist)))
1510       (p4-exec-p4 ch-buffer
1511                   (list "print" "-q" (concat cur-file "@" base-ch)) t)
1512       (save-excursion
1513         (set-buffer ch-buffer)
1514         (goto-char (point-min))
1515         (while (re-search-forward ".*\n" nil t)
1516           (replace-match (concat base-ch "\n"))))
1517       (while (> (length tmp-alst) 1)
1518         (let ((ch-1 (car (car  tmp-alst)))
1519               (ch-2 (car (cadr tmp-alst)))
1520               (file1 (nth P4-FILE (cdr (car  tmp-alst))))
1521               (file2 (nth P4-FILE (cdr (cadr tmp-alst))))
1522               ins-string)
1523           (setq ins-string (format "%d\n" ch-2))
1524           (p4-exec-p4 buffer (list "diff2"
1525                                    (format "%s@%d" file1 ch-1)
1526                                    (format "%s@%d" file2 ch-2)) t)
1527           (save-excursion
1528             (set-buffer buffer)
1529             (goto-char (point-max))
1530             (while (re-search-backward p4-blame-revision-regex nil t)
1531               (let ((la (string-to-int (match-string 1)))
1532                     (lb (string-to-int (match-string 2)))
1533                     (op (match-string 3))
1534                     (ra (string-to-int (match-string 4)))
1535                     (rb (string-to-int (match-string 5))))
1536                 (if (= lb 0)
1537                     (setq lb la))
1538                 (if (= rb 0)
1539                     (setq rb ra))
1540                 (cond ((string= op "a")
1541                        (setq la (1+ la)))
1542                       ((string= op "d")
1543                        (setq ra (1+ ra))))
1544                 (save-excursion
1545                   (set-buffer ch-buffer)
1546                   (goto-line la)
1547                   (let ((beg (point)))
1548                     (forward-line (1+ (- lb la)))
1549                     (delete-region beg (point)))
1550                   (while (<= ra rb)
1551                     (insert ins-string)
1552                     (setq ra (1+ ra)))))))
1553           (setq tmp-alst (cdr tmp-alst))))
1554       (p4-noinput-buffer-action "print" nil t
1555                                 (list (format "%s#%d" fullname head-rev))
1556                                 t)
1557       (p4-font-lock-buffer p4-output-buffer-name)
1558       (let (line cnum (old-cnum 0) change-data
1559             xth-rev xth-date xth-auth xth-file)
1560         (save-excursion
1561           (set-buffer buffer)
1562           (goto-line 2)
1563           (move-to-column 0)
1564           (p4-insert-no-properties "Change  Rev       Date  Author\n")
1565           (while (setq line (p4-read-depot-output ch-buffer))
1566             (setq cnum (string-to-int line))
1567             (if (= cnum old-cnum)
1568                 (p4-insert-no-properties (format "%29s : " ""))
1569
1570               ;; extract the change data from our alist: remember,
1571               ;; `eq' works for integers so we can use assq here:
1572               (setq change-data (cdr (assq cnum ch-alist))
1573                     xth-rev     (nth P4-REV  change-data)
1574                     xth-date    (nth P4-DATE change-data)
1575                     xth-auth    (nth P4-AUTH change-data)
1576                     xth-file    (nth P4-FILE change-data))
1577
1578               (p4-insert-no-properties
1579                (format "%6d %4d %10s %7s: " cnum xth-rev xth-date xth-auth))
1580               (move-to-column 0)
1581               (if (looking-at p4-blame-index-regex)
1582                   (let ((nth-cnum (match-string 1))
1583                         (nth-revn (match-string 2))
1584                         (nth-user (match-string 4)))
1585                     (p4-create-active-link (match-beginning 1)
1586                                            (match-end 1)
1587                                            (list (cons 'change nth-cnum)))
1588                     ;; revision needs to be linked to a file now that we
1589                     ;; follow integrations (branches):
1590                     (p4-create-active-link (match-beginning 2)
1591                                            (match-end 2)
1592                                            (list (cons 'rev  nth-revn)
1593                                                  (cons 'link-depot-name xth-file)))
1594                     (p4-create-active-link (match-beginning 4)
1595                                            (match-end 4)
1596                                            (list (cons 'user nth-user)))
1597                     ;; truncate the user name:
1598                     (let ((start (+ (match-beginning 4) 7))
1599                           (end (match-end 4)))
1600                       (if (> end start)
1601                           (delete-region start end))))))
1602             (setq old-cnum cnum)
1603             (forward-line))))
1604
1605       (kill-buffer ch-buffer))
1606     (let ((buffer-name (concat "*P4 print-revs " file-name "*")))
1607       (p4-activate-print-buffer buffer-name nil)
1608       (save-excursion
1609         (set-buffer buffer-name)
1610         (setq truncate-lines t)
1611         (use-local-map p4-print-rev-map)))))
1612
1613 ;; The p4 refresh command
1614 (defp4cmd p4-refresh ()
1615   "sync" "Refresh the contents of an unopened file. \\[p4-refresh].
1616
1617 This is equivalent to \"sync -f\"
1618 "
1619   (interactive)
1620   (let ((args (p4-buffer-file-name)))
1621     (if (or current-prefix-arg (not args))
1622         (setq args (p4-make-list-from-string
1623                     (p4-read-arg-string "p4 refresh: ")))
1624       (setq args (list args)))
1625     (p4-noinput-buffer-action "refresh" nil t args)
1626     (p4-refresh-files-in-buffers)
1627     (p4-make-depot-list-buffer
1628      (concat "*P4 Refresh: (" (p4-current-client) ") " (car args) "*"))))
1629
1630 ;; The p4 get/sync command
1631 (defp4cmd p4-sync ()
1632   "sync"
1633   "To synchronise the local view with the depot, type \\[p4-get].\n"
1634   (interactive)
1635   (p4-get))
1636
1637 (defp4cmd p4-get ()
1638   "sync"
1639   "To synchronise the local view with the depot, type \\[p4-get].\n"
1640   (interactive)
1641   (let (args)
1642     (if current-prefix-arg
1643         (setq args (p4-make-list-from-string (p4-read-arg-string "p4 get: "))))
1644     (p4-noinput-buffer-action "get" nil t args)
1645     (p4-refresh-files-in-buffers)
1646     (p4-make-depot-list-buffer
1647      (concat "*P4 Get: (" (p4-current-client) ") " (car args) "*"))))
1648
1649 ;; The p4 have command
1650 (defp4cmd p4-have ()
1651   "have" "To list revisions last gotten, type \\[p4-have].\n"
1652   (interactive)
1653   (let ((args (list "...")))
1654     (if current-prefix-arg
1655         (setq args (p4-make-list-from-string
1656                     (p4-read-arg-string "p4 have: " (p4-buffer-file-name-2)))))
1657     (p4-noinput-buffer-action "have" nil t args)
1658     (p4-make-depot-list-buffer
1659      (concat "*P4 Have: (" (p4-current-client) ") " (car args) "*"))))
1660
1661 ;; The p4 changes command
1662 (defp4cmd p4-changes ()
1663   "changes" "To list changes, type \\[p4-changes].\n"
1664   (interactive)
1665   (let ((arg-list (list "-m" "200" "...")))
1666     (if current-prefix-arg
1667         (setq arg-list (p4-make-list-from-string
1668                         (p4-read-arg-string "p4 changes: " "-m 200"))))
1669     (p4-file-change-log "changes" arg-list)))
1670
1671 ;; The p4 help command
1672 (defp4cmd p4-help (arg)
1673   "help" "To print help message, type \\[p4-help].
1674
1675 Argument ARG command for which help is needed.
1676 "
1677   (interactive (list (p4-make-list-from-string
1678                       (p4-read-arg-string "Help on which command: "
1679                                           nil "help"))))
1680   (p4-noinput-buffer-action "help" nil t arg)
1681   (p4-make-basic-buffer "*P4 help*"))
1682
1683 (defun p4-make-basic-buffer (buf-name &optional map)
1684   "rename `p4-output-buffer-name' to buf-name \(which will be killed first if
1685 it already exists\), set its local map to map, if specified, or
1686 `p4-basic-map' otherwise. Makes the buffer read only."
1687   (get-buffer-create buf-name)
1688   (kill-buffer buf-name)
1689   (set-buffer p4-output-buffer-name)
1690   (goto-char (point-min))
1691   (rename-buffer buf-name t)
1692   (use-local-map (if (keymapp map) map p4-basic-map))
1693   (setq buffer-read-only t)
1694   (p4-move-buffer-point-to-top buf-name))
1695
1696 ;; The p4 info command
1697 (defp4cmd p4-info ()
1698   "info" "To print out client/server information, type \\[p4-info].\n"
1699   (interactive)
1700   (p4-noinput-buffer-action "info" nil t)
1701   (p4-make-basic-buffer "*P4 info*"))
1702
1703 ;; The p4 integrate command
1704 (defp4cmd p4-integ ()
1705   "integ" "To schedule integrations between branches, type \\[p4-integ].\n"
1706   (interactive)
1707   (let ((args (p4-make-list-from-string
1708                (p4-read-arg-string "p4 integ: " "-b "))))
1709     (p4-noinput-buffer-action "integ" nil t args)
1710     (p4-make-depot-list-buffer "*P4 integ*")))
1711
1712 (defp4cmd p4-resolve ()
1713   "resolve"
1714   "To merge open files with other revisions or files, type \\[p4-resolve].\n"
1715   (interactive)
1716   (let (buffer args (buf-name "*p4 resolve*"))
1717     (if current-prefix-arg
1718         (setq args (p4-make-list-from-string
1719                     (p4-read-arg-string "p4 resolve: " nil))))
1720     (setq buffer (get-buffer buf-name))
1721     (if (and (buffer-live-p buffer)
1722              (not (comint-check-proc buffer)))
1723         (save-excursion
1724           (let ((cur-dir default-directory))
1725             (set-buffer buffer)
1726             (cd cur-dir)
1727             (goto-char (point-max))
1728             (insert "\n--------\n\n"))))
1729     (setq args (cons "resolve" args))
1730     (setq buffer (apply 'make-comint "p4 resolve" p4-executable nil "-d" default-directory args))
1731     (set-buffer buffer)
1732     (comint-mode)
1733     (display-buffer buffer)
1734     (select-window (get-buffer-window buffer))
1735     (goto-char (point-max))))
1736
1737 (defp4cmd p4-rename ()
1738   "rename" "To rename a file in the depot, type \\[p4-rename].
1739
1740 This command will execute the integrate/delete commands automatically.
1741 "
1742   (interactive)
1743   (let (from-file to-file)
1744     (setq from-file (p4-read-arg-string "rename from: " (p4-buffer-file-name-2)))
1745     (setq to-file (p4-read-arg-string "rename to: " (p4-buffer-file-name-2)))
1746     (p4-noinput-buffer-action "integ" nil t (list from-file to-file))
1747     (p4-exec-p4 (get-buffer-create p4-output-buffer-name)
1748                 (list "delete" from-file)
1749                 nil)))
1750
1751 (defun p4-scroll-down-1-line ()
1752   "Scroll down one line"
1753   (interactive)
1754   (scroll-down 1))
1755
1756 (defun p4-scroll-up-1-line ()
1757   "Scroll up one line"
1758   (interactive)
1759   (scroll-up 1))
1760
1761 (defun p4-scroll-down-1-window ()
1762   "Scroll down one window"
1763   (interactive)
1764   (scroll-down
1765    (- (window-height) next-screen-context-lines)))
1766
1767 (defun p4-scroll-up-1-window ()
1768   "Scroll up one window"
1769   (interactive)
1770   (scroll-up
1771    (- (window-height) next-screen-context-lines)))
1772
1773 (defun p4-top-of-buffer ()
1774   "Top of buffer"
1775   (interactive)
1776   (goto-char (point-min)))
1777
1778 (defun p4-bottom-of-buffer ()
1779   "Bottom of buffer"
1780   (interactive)
1781   (goto-char (point-max)))
1782
1783 (defun p4-delete-other-windows ()
1784   "Make buffer full height"
1785   (interactive)
1786   (delete-other-windows))
1787
1788 (defun p4-goto-next-diff ()
1789   "Next diff"
1790   (interactive)
1791   (goto-char (window-start))
1792   (if (= (point) (point-max))
1793       (error "At bottom"))
1794   (forward-line 1)
1795   (re-search-forward "^====" nil "")
1796   (beginning-of-line)
1797   (set-window-start (selected-window) (point)))
1798
1799 (defun p4-goto-prev-diff ()
1800   "Previous diff"
1801   (interactive)
1802   (if (= (point) (point-min))
1803       (error "At top"))
1804   (goto-char (window-start))
1805   (re-search-backward "^====" nil "")
1806   (set-window-start (selected-window) (point)))
1807
1808 (defun p4-next-depot-file ()
1809   "Next file"
1810   (interactive)
1811   (goto-char (window-start))
1812   (if (= (point) (point-max))
1813       (error "At bottom"))
1814   (forward-line 1)
1815   (re-search-forward "^//[^/@# ][^/@#]*/[^@#]+#[0-9]+ - " nil "")
1816   (beginning-of-line)
1817   (set-window-start (selected-window) (point)))
1818
1819 (defun p4-prev-depot-file ()
1820   "Previous file"
1821   (interactive)
1822   (if (= (point) (point-min))
1823       (error "At top"))
1824   (goto-char (window-start))
1825   (re-search-backward "^//[^/@# ][^/@#]*/[^@#]+#[0-9]+ - " nil "")
1826   (set-window-start (selected-window) (point)))
1827
1828
1829 (defun p4-next-depot-diff ()
1830   "Next diff"
1831   (interactive)
1832   (goto-char (window-start))
1833   (if (= (point) (point-max))
1834       (error "At bottom"))
1835   (forward-line 1)
1836   (re-search-forward "^\\(@@\\|\\*\\*\\* \\|[0-9]+[,acd]\\)" nil "")
1837   (beginning-of-line)
1838   (set-window-start (selected-window) (point)))
1839
1840 (defun p4-prev-depot-diff ()
1841   "Previous diff"
1842   (interactive)
1843   (if (= (point) (point-min))
1844       (error "At top"))
1845   (goto-char (window-start))
1846   (re-search-backward "^\\(@@\\|\\*\\*\\* \\|[0-9]+[,acd]\\)" nil "")
1847   (set-window-start (selected-window) (point)))
1848
1849 (defun p4-moveto-print-rev-column (old-column)
1850   (let ((colon (save-excursion
1851                  (move-to-column 0)
1852                  (if (looking-at "[^:\n]*:")
1853                      (progn
1854                        (goto-char (match-end 0))
1855                        (current-column))
1856                    0))))
1857     (move-to-column old-column)
1858     (if (and (< (current-column) colon)
1859              (re-search-forward "[^ ][ :]" nil t))
1860         (goto-char (match-beginning 0)))))
1861
1862 (defun p4-next-change-rev-line ()
1863   "Next change/revision line"
1864   (interactive)
1865   (let ((c (current-column)))
1866     (move-to-column 1)
1867     (re-search-forward "^ *[0-9]+ +[0-9]+[^:]+:" nil "")
1868     (p4-moveto-print-rev-column c)))
1869
1870 (defun p4-prev-change-rev-line ()
1871   "Previous change/revision line"
1872   (interactive)
1873   (let ((c (current-column)))
1874     (forward-line -1)
1875     (move-to-column 32)
1876     (re-search-backward "^ *[0-9]+ +[0-9]+[^:]*:" nil "")
1877     (p4-moveto-print-rev-column c)))
1878
1879 (defun p4-toggle-line-wrap ()
1880   "Toggle line wrap mode"
1881   (interactive)
1882   (setq truncate-lines (not truncate-lines))
1883   (save-window-excursion
1884     (recenter)))
1885
1886 (defun p4-quit-current-buffer (pnt)
1887   "Quit a buffer"
1888   (interactive "d")
1889   (if (not (one-window-p))
1890       (delete-window)
1891     (bury-buffer)))
1892
1893 (defun p4-buffer-mouse-clicked (event)
1894   "Function to translate the mouse clicks in a P4 filelog buffer to
1895 character events"
1896   (interactive "e")
1897   (let (win pnt)
1898     (cond (p4-running-xemacs
1899            (setq win (event-window event))
1900            (setq pnt (event-point event)))
1901           (p4-running-emacs
1902            (setq win (posn-window (event-end event)))
1903            (setq pnt (posn-point (event-start event)))))
1904     (select-window win)
1905     (goto-char pnt)
1906     (p4-buffer-commands pnt)))
1907
1908 (defun p4-buffer-mouse-clicked-3 (event)
1909   "Function to translate the mouse clicks in a P4 filelog buffer to
1910 character events"
1911   (interactive "e")
1912   (let (win pnt)
1913     (cond (p4-running-xemacs
1914            (setq win (event-window event))
1915            (setq pnt (event-point event)))
1916           (p4-running-emacs
1917            (setq win (posn-window (event-end event)))
1918            (setq pnt (posn-point (event-start event)))))
1919     (select-window win)
1920     (goto-char pnt)
1921     (let ((link-name (or (get-char-property pnt 'link-client-name)
1922                          (get-char-property pnt 'link-depot-name)))
1923           (rev (get-char-property pnt 'rev)))
1924       (cond (link-name
1925              (p4-diff))
1926             (rev
1927              (p4-diff2 rev "#head"))
1928             (t
1929              (error "No file to diff!"))))))
1930
1931 (defun p4-buffer-commands (pnt)
1932   "Function to get a given property and do the appropriate command on it"
1933   (interactive "d")
1934   (let ((rev (get-char-property pnt 'rev))
1935         (change (get-char-property pnt 'change))
1936         (action (get-char-property pnt 'action))
1937         (user (get-char-property pnt 'user))
1938         (client (get-char-property pnt 'client))
1939         (label (get-char-property pnt 'label))
1940         (branch (get-char-property pnt 'branch))
1941         (filename (p4-buffer-file-name-2)))
1942     (cond ((and (not action) rev)
1943            (let ((fn1 (concat filename "#" rev)))
1944              (p4-noinput-buffer-action "print" nil t (list fn1))
1945              (p4-activate-print-buffer "*P4 print*" t)))
1946           (action
1947            (let* ((rev2 (int-to-string (1- (string-to-int rev))))
1948                   (fn1 (concat filename "#" rev))
1949                   (fn2 (concat filename "#" rev2)))
1950              (if (> (string-to-int rev2) 0)
1951                  (progn
1952                    (p4-noinput-buffer-action
1953                     "diff2" nil t
1954                     (append (p4-make-list-from-string
1955                              p4-default-diff-options)
1956                             (list fn2 fn1)))
1957                    (p4-activate-diff-buffer "*P4 diff*"))
1958                (error "There is no earlier revision to diff."))))
1959           (change (p4-describe-internal
1960                    (append (p4-make-list-from-string p4-default-diff-options)
1961                            (list change))))
1962           (user (p4-async-process-command "user" nil
1963                                           (concat
1964                                            "*P4 User: " user "*")
1965                                           "user" (list user)))
1966           (client (p4-async-process-command
1967                    "client" "Description:\n\t"
1968                    (concat "*P4 Client: " client "*") "client" (list client)))
1969           (label (p4-label (list label)))
1970           (branch (p4-branch (list branch)))
1971
1972           ;; Check if a "filename link" or an active "diff buffer area" was
1973           ;; selected.
1974           (t
1975            (let ((link-client-name (get-char-property pnt 'link-client-name))
1976                  (link-depot-name (get-char-property pnt 'link-depot-name))
1977                  (block-client-name (get-char-property pnt 'block-client-name))
1978                  (block-depot-name (get-char-property pnt 'block-depot-name))
1979                  (p4-history-for (get-char-property pnt 'history-for))
1980                  (first-line (get-char-property pnt 'first-line))
1981                  (start (get-char-property pnt 'start)))
1982              (cond
1983               (p4-history-for
1984                (p4-file-change-log "filelog" (list p4-history-for)))
1985               ((or link-client-name link-depot-name)
1986                (p4-find-file-or-print-other-window
1987                 link-client-name link-depot-name))
1988               ((or block-client-name block-depot-name)
1989                (if first-line
1990                    (let ((c (max 0 (- pnt
1991                                       (save-excursion
1992                                         (goto-char pnt)
1993                                         (beginning-of-line)
1994                                         (point))
1995                                       1)))
1996                          (r first-line))
1997                      (save-excursion
1998                        (goto-char start)
1999                        (while (re-search-forward "^[ +>].*\n" pnt t)
2000                          (setq r (1+ r))))
2001                      (p4-find-file-or-print-other-window
2002                       block-client-name block-depot-name)
2003                      (goto-line r)
2004                      (if (not block-client-name)
2005                          (forward-line 1))
2006                      (beginning-of-line)
2007                      (goto-char (+ (point) c)))
2008                  (p4-find-file-or-print-other-window
2009                   block-client-name block-depot-name)))
2010               (t
2011                (error "There is no file at that cursor location!"))))))))
2012
2013 (defun p4-find-file-or-print-other-window (client-name depot-name)
2014   (if client-name
2015       (find-file-other-window client-name)
2016     (p4-noinput-buffer-action "print" nil t
2017                               (list depot-name))
2018     (p4-activate-print-buffer depot-name t)
2019     (other-window 1)))
2020
2021 (defun p4-find-file-other-window ()
2022   "Open/print file"
2023   (interactive)
2024   (let ((link-client-name (get-char-property (point) 'link-client-name))
2025         (link-depot-name (get-char-property (point) 'link-depot-name))
2026         (block-client-name (get-char-property (point) 'block-client-name))
2027         (block-depot-name (get-char-property (point) 'block-depot-name)))
2028     (cond ((or link-client-name link-depot-name)
2029            (p4-find-file-or-print-other-window
2030             link-client-name link-depot-name)
2031            (other-window 1))
2032           ((or block-client-name block-depot-name)
2033            (p4-find-file-or-print-other-window
2034             block-client-name block-depot-name)
2035            (other-window 1)))))
2036
2037 (defun p4-filelog-short-format ()
2038   "Short format"
2039   (interactive)
2040   (setq buffer-invisibility-spec t)
2041   (redraw-display))
2042
2043 (defun p4-filelog-long-format ()
2044   "Long format"
2045   (interactive)
2046   (setq buffer-invisibility-spec (list))
2047   (redraw-display))
2048
2049 (defun p4-scroll-down-1-line-other-w ()
2050   "Scroll other window down one line"
2051   (interactive)
2052   (scroll-other-window -1))
2053
2054 (defun p4-scroll-up-1-line-other-w ()
2055   "Scroll other window up one line"
2056   (interactive)
2057   (scroll-other-window 1))
2058
2059 (defun p4-scroll-down-1-window-other-w ()
2060   "Scroll other window down one window"
2061   (interactive)
2062   (scroll-other-window
2063    (- next-screen-context-lines (window-height))))
2064
2065 (defun p4-scroll-up-1-window-other-w ()
2066   "Scroll other window up one window"
2067   (interactive)
2068   (scroll-other-window
2069    (- (window-height) next-screen-context-lines)))
2070
2071 (defun p4-top-of-buffer-other-w ()
2072   "Top of buffer, other window"
2073   (interactive)
2074   (other-window 1)
2075   (goto-char (point-min))
2076   (other-window -1))
2077
2078 (defun p4-bottom-of-buffer-other-w ()
2079   "Bottom of buffer, other window"
2080   (interactive)
2081   (other-window 1)
2082   (goto-char (point-max))
2083   (other-window -1))
2084
2085 (defun p4-goto-next-change ()
2086   "Next change"
2087   (interactive)
2088   (let ((c (current-column)))
2089     (forward-line 1)
2090     (while (get-char-property (point) 'invisible)
2091       (forward-line 1))
2092     (move-to-column c)))
2093
2094 (defun p4-goto-prev-change ()
2095   "Previous change"
2096   (interactive)
2097   (let ((c (current-column)))
2098     (forward-line -1)
2099     (while (get-char-property (point) 'invisible)
2100       (forward-line -1))
2101     (move-to-column c)))
2102
2103
2104 ;; Activate special handling for a buffer generated with a diff-like command
2105 (make-face 'p4-diff-file-face)
2106 (set-face-background 'p4-diff-file-face "gray90")
2107
2108 (make-face 'p4-diff-head-face)
2109 (set-face-background 'p4-diff-head-face "gray95")
2110
2111 (make-face 'p4-diff-ins-face)
2112 (set-face-foreground 'p4-diff-ins-face "blue")
2113
2114 (make-face 'p4-diff-del-face)
2115 (set-face-foreground 'p4-diff-del-face "red")
2116
2117 (make-face 'p4-diff-change-face)
2118 (set-face-foreground 'p4-diff-change-face "dark green")
2119
2120 (defun p4-buffer-set-face-property (regexp face-property)
2121   (save-excursion
2122     (goto-char (point-min))
2123     (while (re-search-forward regexp nil t)
2124       (let ((start (match-beginning 0))
2125             (end (match-end 0)))
2126         (p4-set-extent-properties start end
2127                                   (list (cons 'face face-property)))))))
2128
2129 (defun p4-activate-diff-buffer (buffer-name)
2130   (p4-make-depot-list-buffer buffer-name)
2131   (save-excursion
2132     (set-buffer buffer-name)
2133     (setq buffer-read-only nil)
2134     (if p4-colorized-diffs
2135         (progn
2136           (p4-buffer-set-face-property "^=.*\n" 'p4-diff-file-face)
2137           (p4-buffer-set-face-property "^[@*].*" 'p4-diff-head-face)
2138           (p4-buffer-set-face-property "^\\([+>].*\n\\)+" 'p4-diff-ins-face)
2139           (p4-buffer-set-face-property "^\\([-<].*\n\\)+" 'p4-diff-del-face)
2140           (p4-buffer-set-face-property "^\\(!.*\n\\)+" 'p4-diff-change-face)))
2141
2142     (goto-char (point-min))
2143     (while (re-search-forward "^\\(==== //\\).*\n"
2144                               nil t)
2145       (let* ((link-client-name (get-char-property (match-end 1) 'link-client-name))
2146              (link-depot-name (get-char-property (match-end 1) 'link-depot-name))
2147              (start (match-beginning 0))
2148              (end (save-excursion
2149                     (if (re-search-forward "^==== " nil t)
2150                         (match-beginning 0)
2151                       (point-max)))))
2152         (if link-client-name
2153             (p4-set-extent-properties start end
2154                                       (list (cons 'block-client-name
2155                                                   link-client-name))))
2156         (if link-depot-name
2157             (p4-set-extent-properties start end
2158                                       (list (cons 'block-depot-name
2159                                                   link-depot-name))))))
2160
2161     (goto-char (point-min))
2162     (while (re-search-forward
2163             (concat "^[@0-9].*\\([cad+]\\)\\([0-9]*\\).*\n"
2164                     "\\(\\(\n\\|[^@0-9\n].*\n\\)*\\)") nil t)
2165       (let ((first-line (string-to-int (match-string 2)))
2166             (start (match-beginning 3))
2167             (end (match-end 3)))
2168         (p4-set-extent-properties start end
2169                                   (list (cons 'first-line first-line)
2170                                         (cons 'start start)))))
2171
2172     (goto-char (point-min))
2173     (let ((stop
2174            (if (re-search-forward "^\\(\\.\\.\\.\\|====\\)" nil t)
2175                (match-beginning 0)
2176              (point-max))))
2177       (p4-find-change-numbers buffer-name (point-min) stop))
2178
2179     (goto-char (point-min))
2180     (if (looking-at "^Change [0-9]+ by \\([^ @]+\\)@\\([^ \n]+\\)")
2181         (let ((user-match 1)
2182               (cl-match 2)
2183               cur-user cur-client)
2184           (setq cur-user (match-string user-match))
2185           (setq cur-client (match-string cl-match))
2186           (p4-create-active-link (match-beginning user-match)
2187                                  (match-end user-match)
2188                                  (list (cons 'user cur-user)))
2189           (p4-create-active-link (match-beginning cl-match)
2190                                  (match-end cl-match)
2191                                  (list (cons 'client cur-client)))))
2192
2193     (use-local-map p4-diff-map)
2194     (setq buffer-read-only t)))
2195
2196
2197 ;; The p4 describe command
2198 (defp4cmd p4-describe ()
2199   "describe" "To get a description for a change number, type \\[p4-describe].\n"
2200   (interactive)
2201   (let ((arg-string (p4-make-list-from-string
2202                      (read-string "p4 describe: "
2203                                   (concat p4-default-diff-options " ")))))
2204     (p4-describe-internal arg-string)))
2205
2206 ;; Internal version of the p4 describe command
2207 (defun p4-describe-internal (arg-string)
2208   (p4-noinput-buffer-action
2209    "describe" nil t arg-string)
2210   (p4-activate-diff-buffer
2211    (concat "*P4 describe: " (p4-list-to-string arg-string) "*")))
2212
2213 ;; The p4 opened command
2214 (defp4cmd p4-opened ()
2215   "opened"
2216   "To display list of files opened for pending change, type \\[p4-opened].\n"
2217   (interactive)
2218   (let (args)
2219     (if current-prefix-arg
2220         (setq args (p4-make-list-from-string
2221                     (p4-read-arg-string "p4 opened: "
2222                                         (p4-buffer-file-name-2)))))
2223     (p4-opened-internal args)))
2224
2225 (defun p4-opened-internal (args)
2226   (let ((p4-client (p4-current-client)))
2227     (p4-noinput-buffer-action "opened" nil t args)
2228     (p4-make-depot-list-buffer (concat "*Opened Files: " p4-client "*"))))
2229
2230 (defun p4-update-opened-list ()
2231   (if (get-buffer-window (concat "*Opened Files: " (p4-current-client) "*"))
2232       (progn
2233         (setq current-prefix-arg nil)
2234         (p4-opened-internal nil))))
2235
2236 (defun p4-regexp-create-links (buffer-name regexp property)
2237   (save-excursion
2238     (set-buffer buffer-name)
2239     (setq buffer-read-only nil)
2240     (goto-char (point-min))
2241     (while (re-search-forward regexp nil t)
2242       (let ((start (match-beginning 1))
2243             (end (match-end 1))
2244             (str (match-string 1)))
2245         (p4-create-active-link start end (list (cons property str)))))
2246     (setq buffer-read-only t)))
2247
2248 ;; The p4 users command
2249 (defp4cmd p4-users ()
2250   "users" "To display list of known users, type \\[p4-users].\n"
2251   (interactive)
2252   (let (args)
2253     (if current-prefix-arg
2254         (setq args (p4-make-list-from-string
2255                     (p4-read-arg-string "p4 users: " nil "user"))))
2256     (p4-noinput-buffer-action "users" nil t args))
2257   (p4-make-basic-buffer "*P4 users*")
2258   (p4-regexp-create-links "*P4 users*" "^\\([^ ]+\\).*\n" 'user))
2259
2260 ;; The p4 jobs command
2261 (defp4cmd p4-jobs ()
2262   "jobs" "To display list of jobs, type \\[p4-jobs].\n"
2263   (interactive)
2264   (let (args)
2265     (if current-prefix-arg
2266         (setq args (p4-make-list-from-string (p4-read-arg-string "p4 jobs: "))))
2267     (p4-noinput-buffer-action "jobs" nil t args))
2268   (p4-make-basic-buffer "*P4 jobs*"))
2269
2270 ;; The p4 fix command
2271 (defp4cmd p4-fix ()
2272   "fix" "To mark jobs as being fixed by a changelist number, type \\[p4-fix].\n"
2273   (interactive)
2274   (let ((args (p4-make-list-from-string (p4-read-arg-string "p4 fix: "
2275                                                             nil "job"))))
2276     (p4-noinput-buffer-action "fix" nil t args)))
2277
2278 ;; The p4 fixes command
2279 (defp4cmd p4-fixes ()
2280   "fixes" "To list what changelists fix what jobs, type \\[p4-fixes].\n"
2281   (interactive)
2282   (let (args)
2283     (if current-prefix-arg
2284         (setq args (p4-make-list-from-string (p4-read-arg-string "p4 fixes: "))))
2285     (p4-noinput-buffer-action "fixes" nil t args)
2286     (p4-make-basic-buffer "*P4 fixes*")))
2287
2288 ;; The p4 where command
2289 (defp4cmd p4-where ()
2290   "where"
2291   "To show how local file names map into depot names, type \\[p4-where].\n"
2292   (interactive)
2293   (let (args)
2294     (if current-prefix-arg
2295         (setq args (p4-make-list-from-string
2296                     (p4-read-arg-string "p4 where: "
2297                                         (p4-buffer-file-name-2)))))
2298     (p4-noinput-buffer-action "where" nil 's args)))
2299
2300
2301 (defun p4-async-process-command (p4-this-command &optional
2302                                                  p4-regexp
2303                                                  p4-this-buffer
2304                                                  p4-out-command
2305                                                  p4-in-args
2306                                                  p4-out-args)
2307   "Internal function to call an asynchronous process with a local buffer,
2308 instead of calling an external client editor to run within emacs.
2309
2310 Arguments:
2311 P4-THIS-COMMAND is the command that called this internal function.
2312
2313 P4-REGEXP is the optional regular expression to search for to set the cursor
2314 on.
2315
2316 P4-THIS-BUFFER is the optional buffer to create. (Default is *P4 <command>*).
2317
2318 P4-OUT-COMMAND is the optional command that will be used as the command to
2319 be called when `p4-async-call-process' is called.
2320
2321 P4-IN-ARGS is the optional argument passed that will be used as the list of
2322 arguments to the P4-THIS-COMMAND.
2323
2324 P4-OUT-ARGS is the optional argument passed that will be used as the list of
2325 arguments to P4-OUT-COMMAND."
2326   (let ((dir default-directory))
2327     (if p4-this-buffer
2328         (set-buffer (get-buffer-create p4-this-buffer))
2329       (set-buffer (get-buffer-create (concat "*P4 " p4-this-command "*"))))
2330     (setq p4-current-command p4-this-command)
2331     (cd dir))
2332   (if (zerop (apply 'call-process-region (point-min) (point-max)
2333                     (p4-check-p4-executable) t t nil
2334                     "-d" default-directory
2335                     p4-current-command "-o"
2336                     p4-in-args))
2337       (progn
2338         (goto-char (point-min))
2339         (insert (concat "# Created using " (p4-emacs-version) ".\n"
2340                         "# Type C-c C-c to submit changes and exit buffer.\n"
2341                         "# Type C-x k to kill current changes.\n"
2342                         "#\n"))
2343         (if p4-regexp (re-search-forward p4-regexp))
2344         (indented-text-mode)
2345         (setq p4-async-minor-mode t)
2346         (setq fill-column 79)
2347         (p4-push-window-config)
2348         (switch-to-buffer-other-window (current-buffer))
2349         (if p4-out-command
2350             (setq p4-current-command p4-out-command))
2351         (setq p4-current-args p4-out-args)
2352         (setq buffer-offer-save t)
2353
2354         (define-key p4-async-minor-map "\C-c\C-c" 'p4-async-call-process)
2355         (run-hooks 'p4-async-command-hook)
2356         (set-buffer-modified-p nil)
2357         (message "C-c C-c to finish editing and exit buffer."))
2358     (error "%s %s -o failed to complete successfully."
2359            (p4-check-p4-executable) p4-current-command)))
2360
2361 (defun p4-async-call-process ()
2362   "Internal function called by `p4-async-process-command' to process the
2363 buffer after editing is done using the minor mode key mapped to `C-c C-c'."
2364   (interactive)
2365   (message "p4 %s ..." p4-current-command)
2366   (let ((max (point-max)) msg
2367         (current-command p4-current-command)
2368         (current-args p4-current-args))
2369     (goto-char max)
2370     (if (zerop (apply 'call-process-region (point-min)
2371                       max (p4-check-p4-executable)
2372                       nil '(t t) nil
2373                       "-d" default-directory
2374                       current-command "-i"
2375                       current-args))
2376         (progn
2377           (goto-char max)
2378           (setq msg (buffer-substring max (point-max)))
2379           (delete-region max (point-max))
2380           (save-excursion
2381             (set-buffer (get-buffer-create p4-output-buffer-name))
2382             (delete-region (point-min) (point-max))
2383             (insert msg))
2384           (kill-buffer nil)
2385           (display-buffer p4-output-buffer-name)
2386           (p4-partial-cache-cleanup current-command)
2387           (message "p4 %s done." current-command)
2388           (if (equal current-command "submit")
2389               (progn
2390                 (p4-refresh-files-in-buffers)
2391                 (p4-check-mode-all-buffers)
2392                 (if p4-notify
2393                     (p4-notify p4-notify-list)))))
2394       (error "%s %s -i failed to complete successfully."
2395              (p4-check-p4-executable)
2396              current-command))))
2397
2398 (defun p4-cmd-line-flags (args)
2399   (memq t (mapcar (lambda (x) (not (not (string-match "^-" x))))
2400                   args)))
2401
2402 ;; The p4 change command
2403 (defp4cmd p4-change ()
2404   "change" "To edit the change specification, type \\[p4-change].\n"
2405   (interactive)
2406   (let (args
2407         (change-buf-name "*P4 New Change*"))
2408     (if (buffer-live-p (get-buffer change-buf-name))
2409         (switch-to-buffer-other-window (get-buffer change-buf-name))
2410       (if current-prefix-arg
2411           (setq args (p4-make-list-from-string
2412                       (p4-read-arg-string "p4 change: " nil))))
2413       (if (p4-cmd-line-flags args)
2414           (p4-noinput-buffer-action "change" nil t args)
2415         (p4-async-process-command "change" "Description:\n\t"
2416                                   change-buf-name nil args)))))
2417
2418 ;; The p4 client command
2419 (defp4cmd p4-client ()
2420   "client" "To edit a client specification, type \\[p4-client].\n"
2421   (interactive)
2422   (let (args
2423         (client-buf-name "*P4 client*"))
2424     (if (buffer-live-p (get-buffer client-buf-name))
2425         (switch-to-buffer-other-window (get-buffer client-buf-name))
2426       (if current-prefix-arg
2427           (setq args (p4-make-list-from-string
2428                       (p4-read-arg-string "p4 client: " nil "client"))))
2429       (if (p4-cmd-line-flags args)
2430           (p4-noinput-buffer-action "client" nil t args)
2431         (p4-async-process-command "client" "\\(Description\\|View\\):\n\t"
2432                                   client-buf-name nil args)))))
2433
2434 (defp4cmd p4-clients ()
2435   "clients" "To list all clients, type \\[p4-clients].\n"
2436   (interactive)
2437   (p4-noinput-buffer-action "clients" nil t nil)
2438   (p4-make-basic-buffer "*P4 clients*")
2439   (p4-regexp-create-links "*P4 clients*" "^Client \\([^ ]+\\).*\n" 'client))
2440
2441 (defp4cmd p4-branch (args)
2442   "branch" "Edit a P4-BRANCH specification using \\[p4-branch]."
2443   (interactive (list
2444                 (p4-make-list-from-string
2445                  (p4-read-arg-string "p4 branch: " nil "branch"))))
2446   (if (or (null args) (equal args (list "")))
2447       (error "Branch must be specified!")
2448     (if (p4-cmd-line-flags args)
2449         (p4-noinput-buffer-action "branch" nil t args)
2450       (p4-async-process-command "branch" "Description:\n\t"
2451                                 (concat "*P4 Branch: "
2452                                         (car (reverse args)) "*")
2453                                 "branch" args))))
2454
2455 (defp4cmd p4-branches ()
2456   "branches" "To list all branches, type \\[p4-branches].\n"
2457   (interactive)
2458   (p4-noinput-buffer-action "branches" nil t nil)
2459   (p4-make-basic-buffer "*P4 branches*")
2460   (p4-regexp-create-links "*P4 branches*" "^Branch \\([^ ]+\\).*\n" 'branch))
2461
2462 (defp4cmd p4-label (args)
2463   "label" "Edit a P4-label specification using \\[p4-label].\n"
2464   (interactive (list
2465                 (p4-make-list-from-string
2466                  (p4-read-arg-string "p4 label: " nil "label"))))
2467   (if (or (null args) (equal args (list "")))
2468       (error "label must be specified!")
2469     (if (p4-cmd-line-flags args)
2470         (p4-noinput-buffer-action "label" nil t args)
2471       (p4-async-process-command "label" "Description:\n\t"
2472                                 (concat "*P4 label: "
2473                                         (car (reverse args)) "*")
2474                                 "label" args))))
2475
2476 (defp4cmd p4-labels ()
2477   "labels" "To display list of defined labels, type \\[p4-labels].\n"
2478   (interactive)
2479   (p4-noinput-buffer-action "labels" nil t nil)
2480   (p4-make-basic-buffer "*P4 labels*")
2481   (p4-regexp-create-links "*P4 labels*" "^Label \\([^ ]+\\).*\n" 'label))
2482
2483 ;; The p4 labelsync command
2484 (defp4cmd p4-labelsync ()
2485   "labelsync"
2486   "To synchronize a label with the current client contents, type \\[p4-labelsync].\n"
2487   (interactive)
2488   (let ((args (p4-make-list-from-string
2489                (p4-read-arg-string "p4 labelsync: "))))
2490     (p4-noinput-buffer-action "labelsync" nil t args))
2491   (p4-make-depot-list-buffer "*P4 labelsync*"))
2492
2493 (defun p4-filter-out (pred lst)
2494   (let (res)
2495     (while lst
2496       (if (not (funcall pred (car lst)))
2497           (setq res (cons (car lst) res)))
2498       (setq lst (cdr lst)))
2499     (reverse res)))
2500
2501 ;; The p4 submit command
2502 (defp4cmd p4-submit (&optional arg)
2503   "submit" "To submit a pending change to the depot, type \\[p4-submit].\n"
2504   (interactive "P")
2505   (let (args
2506         (submit-buf-name "*P4 Submit*")
2507         (change-list (if (integerp arg) arg)))
2508     (if (buffer-live-p (get-buffer submit-buf-name))
2509         (switch-to-buffer-other-window (get-buffer submit-buf-name))
2510       (if change-list
2511           (setq args (list "-c" (int-to-string change-list)))
2512         (if current-prefix-arg
2513             (setq args (p4-make-list-from-string
2514                         (p4-read-arg-string "p4 submit: " nil)))))
2515       (setq args (p4-filter-out (lambda (x) (string= x "-c")) args))
2516       (p4-save-opened-files)
2517       (if (or (not (and p4-check-empty-diffs (p4-empty-diff-p)))
2518               (progn
2519                 (ding t)
2520                 (yes-or-no-p
2521                  "File with empty diff opened for edit. Submit anyway? ")))
2522           (p4-async-process-command "change" "Description:\n\t"
2523                                     submit-buf-name "submit" args)))))
2524
2525 ;; The p4 user command
2526 (defp4cmd p4-user ()
2527   "user" "To create or edit a user specification, type \\[p4-user].\n"
2528   (interactive)
2529   (let (args)
2530     (if current-prefix-arg
2531         (setq args (p4-make-list-from-string
2532                     (p4-read-arg-string "p4 user: " nil "user"))))
2533     (if (p4-cmd-line-flags args)
2534         (p4-noinput-buffer-action "user" nil t args)
2535       (p4-async-process-command "user" nil nil nil args))))
2536
2537 ;; The p4 job command
2538 (defp4cmd p4-job ()
2539   "job" "To create or edit a job, type \\[p4-job].\n"
2540   (interactive)
2541   (let (args)
2542     (if current-prefix-arg
2543         (setq args (p4-make-list-from-string
2544                     (p4-read-arg-string "p4 job: " nil "job"))))
2545     (if (p4-cmd-line-flags args)
2546         (p4-noinput-buffer-action "job" nil t args)
2547       (p4-async-process-command "job" "Description:\n\t" nil nil args))))
2548
2549 ;; The p4 jobspec command
2550 (defp4cmd p4-jobspec ()
2551   "jobspec" "To edit the job template, type \\[p4-jobspec].\n"
2552   (interactive)
2553   (p4-async-process-command "jobspec"))
2554
2555 ;; A function to set the current P4 client name
2556 (defun p4-set-client-name (p4-new-client-name)
2557   "To set the current value of P4CLIENT, type \\[p4-set-client-name].
2558
2559 This will change the current client from the previous client to the new
2560 given value.
2561
2562 Setting this value to nil would disable P4 Version Checking.
2563
2564 `p4-set-client-name' will complete any client names set using the function
2565 `p4-set-my-clients'. The strictness of completion will depend on the
2566 variable `p4-strict-complete' (default is t).
2567
2568 Argument P4-NEW-CLIENT-NAME The new client to set to. The default value is
2569 the current client."
2570   (interactive (list
2571                 (completing-read "Change Client to: "
2572                                  (if p4-my-clients
2573                                      p4-my-clients
2574                                    'p4-clients-completion)
2575                                  nil p4-strict-complete (p4-current-client))
2576                 ))
2577   (if (or (null p4-new-client-name) (equal p4-new-client-name "nil"))
2578       (progn
2579         (setenv "P4CLIENT" nil)
2580         (if (not (getenv "P4CONFIG"))
2581             (message
2582              "P4 Version check disabled. Set a valid client name to enable."
2583              )))
2584     (setenv "P4CLIENT" p4-new-client-name)
2585     (message "P4CLIENT changed to %s" p4-new-client-name)
2586     (run-hooks 'p4-set-client-hooks)))
2587
2588 (defun p4-get-client-config ()
2589   "To get the current value of the environment variable P4CONFIG,
2590 type \\[p4-get-client-config].
2591
2592 This will be the current configuration that is in use for access through
2593 Emacs P4."
2594
2595   (interactive)
2596   (message "P4CONFIG is %s" (getenv "P4CONFIG")))
2597
2598 (defun p4-set-client-config (p4config)
2599   "To set the P4CONFIG variable, for use with the current versions of the p4
2600 client.
2601
2602 P4CONFIG is a more flexible mechanism wherein p4 will find the current
2603 client automatically by checking the config file found at the root of a
2604 directory \(recursing all the way to the top\).
2605
2606 In this scenario, a P4CLIENT variable need not be explicitly set.
2607 "
2608   (interactive "sP4 Config: ")
2609   (if (or (null p4config) (equal p4config ""))
2610       (message "P4CONFIG not changed.")
2611     (setenv "P4CONFIG" p4config)
2612     (message "P4CONFIG changed to %s" p4config)))
2613
2614 (defun p4-set-my-clients (client-list)
2615   "To set the client completion list used by `p4-set-client-name', use
2616 this function in your .emacs (or any lisp interaction buffer).
2617
2618 This will change the current client list from the previous list to the new
2619 given value.
2620
2621 Setting this value to nil would disable client completion by
2622 `p4-set-client-name'.
2623
2624 The strictness of completion will depend on the variable
2625 `p4-strict-complete' (default is t).
2626
2627 Argument CLIENT-LIST is the 'list' of clients.
2628
2629 To set your clients using your .emacs, use the following:
2630
2631 \(load-library \"p4\"\)
2632 \(p4-set-my-clients \'(client1 client2 client3)\)"
2633   (setq p4-my-clients nil)
2634   (let (p4-tmp-client-var)
2635     (while client-list
2636       (setq p4-tmp-client-var (format "%s" (car client-list)))
2637       (setq client-list (cdr client-list))
2638       (setq p4-my-clients (append p4-my-clients
2639                                   (list (list p4-tmp-client-var)))))))
2640
2641 ;; A function to get the current P4PORT
2642 (defun p4-get-p4-port ()
2643   "To get the current value of the environment variable P4PORT, type \
2644 \\[p4-get-p4-port].
2645
2646 This will be the current server/port that is in use for access through Emacs
2647 P4."
2648   (interactive)
2649   (let ((port (p4-current-server-port)))
2650     (message "P4PORT is [local: %s], [global: %s]" port (getenv "P4PORT"))
2651     port))
2652
2653 ;; A function to set the current P4PORT
2654 (defun p4-set-p4-port (p4-new-p4-port)
2655   "To set the current value of P4PORT, type \\[p4-set-p4-port].
2656
2657 This will change the current server from the previous server to the new
2658 given value.
2659
2660 Argument P4-NEW-P4-PORT The new server:port to set to. The default value is
2661 the current value of P4PORT."
2662   (interactive (list (let
2663                          ((symbol (read-string "Change server:port to: "
2664                                                (getenv "P4PORT"))))
2665                        (if (equal symbol "")
2666                            (getenv "P4PORT")
2667                          symbol))))
2668   (if (or (null p4-new-p4-port) (equal p4-new-p4-port "nil"))
2669       (progn
2670         (setenv "P4PORT" nil)
2671         (if (not (getenv "P4CONFIG"))
2672             (message
2673              "P4 Version check disabled. Set a valid server:port to enable.")))
2674     (setenv "P4PORT" p4-new-p4-port)
2675     (message "P4PORT changed to %s" p4-new-p4-port)))
2676
2677 ;; The find-file hook for p4.
2678 (defun p4-find-file-hook ()
2679   "To check while loading the file, if it is a P4 version controlled file."
2680   (if (or (getenv "P4CONFIG") (getenv "P4CLIENT"))
2681       (p4-detect-p4)))
2682
2683 (defun p4-refresh-refresh-list (buffile bufname)
2684   "Refresh the list of files to be refreshed."
2685   (setq p4-all-buffer-files (delete (list buffile bufname)
2686                                     p4-all-buffer-files))
2687   (if (not p4-all-buffer-files)
2688       (progn
2689         (if (and p4-running-emacs (timerp p4-file-refresh-timer))
2690             (cancel-timer p4-file-refresh-timer))
2691         (if (and p4-running-xemacs p4-file-refresh-timer)
2692             (disable-timeout p4-file-refresh-timer))
2693         (setq p4-file-refresh-timer nil))))
2694
2695 ;; Set keymap. We use the C-x p Keymap for all perforce commands
2696 (defvar p4-prefix-map
2697   (let ((map (make-sparse-keymap)))
2698     (define-key map "a" 'p4-add)
2699     (define-key map "b" 'p4-bug-report)
2700     (define-key map "B" 'p4-branch)
2701     (define-key map "c" 'p4-client)
2702     (define-key map "C" 'p4-changes)
2703     (define-key map "d" 'p4-diff2)
2704     (define-key map "D" 'p4-describe)
2705     (define-key map "e" 'p4-edit)
2706     (define-key map "E" 'p4-reopen)
2707     (define-key map "\C-f" 'p4-depot-find-file)
2708     (define-key map "f" 'p4-filelog)
2709     (define-key map "F" 'p4-files)
2710     (define-key map "g" 'p4-get-client-name)
2711     (define-key map "G" 'p4-get)
2712     (define-key map "h" 'p4-help)
2713     (define-key map "H" 'p4-have)
2714     (define-key map "i" 'p4-info)
2715     (define-key map "I" 'p4-integ)
2716     (define-key map "j" 'p4-job)
2717     (define-key map "J" 'p4-jobs)
2718     (define-key map "l" 'p4-label)
2719     (define-key map "L" 'p4-labels)
2720     (define-key map "\C-l" 'p4-labelsync)
2721     (define-key map "m" 'p4-rename)
2722     (define-key map "n" 'p4-notify)
2723     (define-key map "o" 'p4-opened)
2724     (define-key map "p" 'p4-print)
2725     (define-key map "P" 'p4-set-p4-port)
2726     (define-key map "q" 'p4-pop-window-config)
2727     (define-key map "r" 'p4-revert)
2728     (define-key map "R" 'p4-refresh)
2729     (define-key map "\C-r" 'p4-resolve)
2730     (define-key map "s" 'p4-set-client-name)
2731     (define-key map "S" 'p4-submit)
2732     (define-key map "t" 'p4-toggle-vc-mode)
2733     (define-key map "u" 'p4-user)
2734     (define-key map "U" 'p4-users)
2735     (define-key map "v" 'p4-emacs-version)
2736     (define-key map "V" 'p4-blame)
2737     (define-key map "w" 'p4-where)
2738     (define-key map "x" 'p4-delete)
2739     (define-key map "X" 'p4-fix)
2740     (define-key map "=" 'p4-diff)
2741     (define-key map "-" 'p4-ediff)
2742     (define-key map "?" 'p4-describe-bindings)
2743     map)
2744   "The Prefix for P4 Library Commands.")
2745
2746 (if (not (keymapp (lookup-key global-map "\C-xp")))
2747     (define-key global-map "\C-xp" p4-prefix-map))
2748
2749 ;; For users interested in notifying a change, a notification list can be
2750 ;; set up using this function.
2751 (defun p4-set-notify-list (p4-new-notify-list &optional p4-supress-stat)
2752   "To set the current value of P4NOTIFY, type \\[p4-set-notify-list].
2753
2754 This will change the current notify list from the existing list to the new
2755 given value.
2756
2757 An empty string will disable notification.
2758
2759 Argument P4-NEW-NOTIFY-LIST is new value of the notification list.
2760 Optional argument P4-SUPRESS-STAT when t will suppress display of the status
2761 message. "
2762
2763   (interactive (list (let
2764                          ((symbol (read-string
2765                                    "Change Notification List to: "
2766                                    p4-notify-list)))
2767                        (if (equal symbol "")
2768                            nil
2769                          symbol))))
2770   (let ((p4-old-notify-list p4-notify-list))
2771     (setenv "P4NOTIFY" p4-new-notify-list)
2772     (setq p4-notify-list p4-new-notify-list)
2773     (setq p4-notify (not (null p4-new-notify-list)))
2774     (if (not p4-supress-stat)
2775         (message "Notification list changed from '%s' to '%s'"
2776                  p4-old-notify-list p4-notify-list))))
2777
2778 ;; To get the current notification list.
2779 (defun p4-get-notify-list ()
2780   "To get the current value of the environment variable P4NOTIFY,
2781 type \\[p4-get-notify-list].
2782
2783    This will be the current notification list that is in use for mailing
2784    change notifications through Emacs P4."
2785
2786   (interactive)
2787   (message "P4NOTIFY is %s" p4-notify-list))
2788
2789 (defun p4-notify (users)
2790   "To notify a list of users of a change submission manually, type
2791 \\[p4-notify].
2792
2793 To do auto-notification, set the notification list with `p4-set-notify-list'
2794 and on each submission, the users in the list will be notified of the
2795 change.
2796
2797 Since this uses the sendmail program, it is mandatory to set the correct
2798 path to the sendmail program in the variable `p4-sendmail-program'.
2799
2800 Also, it is mandatory to set the user's email address in the variable
2801 `p4-user-email'.
2802
2803 Argument USERS The users to notify to. The default value is the notification
2804 list."
2805   (interactive (list (let
2806                          ((symbol (read-string "Notify whom? "
2807                                                p4-notify-list)))
2808                        (if (equal symbol "")
2809                            nil
2810                          symbol))))
2811   (p4-set-notify-list users t)
2812   (if (and p4-sendmail-program p4-user-email)
2813       (p4-do-notify)
2814     (message "Please set p4-sendmail-program and p4-user-email variables.")))
2815
2816 (defun p4-do-notify ()
2817   "This is the internal notification function called by `p4-notify'."
2818   (save-excursion
2819     (if (and p4-notify-list (not (equal p4-notify-list "")))
2820         (save-excursion
2821           (set-buffer (get-buffer-create p4-output-buffer-name))
2822           (goto-char (point-min))
2823           (if (re-search-forward "[0-9]+.*submitted" (point-max) t)
2824               (let (p4-matched-change)
2825                 (setq p4-matched-change (substring (match-string 0) 0 -10))
2826                 (set-buffer (get-buffer-create "*P4 Notify*"))
2827                 (delete-region (point-min) (point-max))
2828                 (call-process-region (point-min) (point-max)
2829                                      (p4-check-p4-executable)
2830                                      t t nil
2831                                      "-d" default-directory
2832                                      "describe" "-s"
2833                                      p4-matched-change)
2834                 (switch-to-buffer "*P4 Notify*")
2835                 (goto-char (point-min))
2836                 (let (p4-chg-desc)
2837                   (if (re-search-forward "^Change.*$" (point-max) t)
2838                       (setq p4-chg-desc (match-string 0))
2839                     (setq p4-chg-desc (concat
2840                                        "Notification of Change "
2841                                        p4-matched-change)))
2842                   (goto-char (point-min))
2843                   (insert
2844                    "From: " p4-user-email "\n"
2845                    "To: P4 Notification Recipients:;\n"
2846                    "Subject: " p4-chg-desc "\n")
2847                   (call-process-region (point-min) (point-max)
2848                                        p4-sendmail-program t t nil
2849                                        "-odi" "-oi" p4-notify-list)
2850
2851                   (kill-buffer nil)))
2852             (save-excursion
2853               (set-buffer (get-buffer-create p4-output-buffer-name))
2854               (goto-char (point-max))
2855               (insert "\np4-do-notify: No Change Submissions found."))))
2856       (save-excursion
2857         (set-buffer (get-buffer-create p4-output-buffer-name))
2858         (goto-char (point-max))
2859         (insert "\np4-do-notify: Notification list not set.")))))
2860
2861 ;; Function to return the current version.
2862 (defun p4-emacs-version ()
2863   "Return the current Emacs-P4 Integration version."
2864   (interactive)
2865   (message (concat (cond (p4-running-xemacs "X")) "Emacs-P4 Integration v%s")
2866            p4-emacs-version))
2867
2868 (defun p4-find-p4-config-file ()
2869   (let ((p4config (getenv "P4CONFIG"))
2870         (p4-cfg-dir (cond ((p4-buffer-file-name)
2871                            (file-name-directory
2872                             (file-truename (p4-buffer-file-name))))
2873                           (t (file-truename default-directory)))))
2874     (if (not p4config)
2875         nil
2876       (let (found at-root)
2877         (while (not (or found at-root))
2878           (let ((parent-dir (file-name-directory
2879                              (directory-file-name
2880                               p4-cfg-dir))))
2881             (if (file-exists-p (concat p4-cfg-dir p4config))
2882                 (setq found (concat p4-cfg-dir p4config)))
2883             (setq at-root (string-equal parent-dir p4-cfg-dir))
2884             (setq p4-cfg-dir parent-dir)))
2885         found))))
2886
2887 (defun p4-detect-p4 ()
2888   (if (or (not p4-use-p4config-exclusively)
2889           (p4-find-p4-config-file))
2890       (p4-check-mode)))
2891
2892 (defun p4-get-add-branch-files (&optional name-list)
2893   (let ((output-buffer (p4-depot-output "opened" name-list))
2894         files depot-map)
2895     (save-excursion
2896       (set-buffer output-buffer)
2897       (goto-char (point-min))
2898       (while (re-search-forward "^\\(//[^/@#]+/[^#\n]*\\)#[0-9]+ - add " nil t)
2899         (setq files (cons (cons (match-string 1) "Add")
2900                           files)))
2901       (goto-char (point-min))
2902       (while (re-search-forward "^\\(//[^/@#]+/[^#\n]*\\)#[0-9]+ - branch " nil t)
2903         (setq files (cons (cons (match-string 1) "Branch")
2904                           files))))
2905     (kill-buffer output-buffer)
2906     (setq depot-map (p4-map-depot-files (mapcar 'car files)))
2907     (mapcar (lambda (x) (cons (cdr (assoc (car x) depot-map))
2908                               (cdr x))) files)))
2909
2910 (defun p4-get-have-files (file-list)
2911   (let ((output-buffer (p4-depot-output "have" file-list))
2912         line files depot-map elt)
2913     (while (setq line (p4-read-depot-output output-buffer))
2914       (if (string-match "^\\(//[^/@#]+/[^#\n]*\\)#\\([0-9]+\\) - " line)
2915           (setq files (cons (cons (match-string 1 line)
2916                                   (match-string 2 line))
2917                             files))))
2918     (kill-buffer output-buffer)
2919     (setq depot-map (p4-map-depot-files (mapcar 'car files)))
2920     (setq files (mapcar (lambda (x) (cons (cdr (assoc (car x) depot-map))
2921                                           (cdr x))) files))
2922     (while file-list
2923       (setq elt (car file-list))
2924       (setq file-list (cdr file-list))
2925       (if (not (assoc elt files))
2926           (setq files (cons (cons elt nil) files))))
2927     files))
2928
2929 ;; A function to check if the file being opened is version controlled by p4.
2930 (defun p4-is-vc (&optional file-mode-cache filename)
2931   "If a file is controlled by P4 then return version else return nil."
2932   (if (not filename)
2933       (setq filename (p4-buffer-file-name)))
2934   (let (version done)
2935     (let ((el (assoc filename file-mode-cache)))
2936       (setq done el)
2937       (setq version (cdr el)))
2938     (if (and (not done) filename)
2939         (let ((output-buffer (p4-depot-output "have" (list filename)))
2940               line)
2941           (setq line (p4-read-depot-output output-buffer))
2942           (kill-buffer output-buffer)
2943           (if (string-match "^//[^/@#]+/[^#\n]*#\\([0-9]+\\) - " line)
2944               (setq version (match-string 1 line)))
2945           (setq done version)))
2946     (if (and (not done) (not file-mode-cache))
2947         (progn
2948           (setq file-mode-cache
2949                 (p4-get-add-branch-files (and filename (list filename))))
2950           (setq version (cdr (assoc filename file-mode-cache)))))
2951     version))
2952
2953 (defun p4-check-mode (&optional file-mode-cache)
2954   "Check to see whether we should export the menu map to this buffer.
2955
2956 Turning on P4 mode calls the hooks in the variable `p4-mode-hook' with
2957 no args."
2958   (setq p4-mode nil)
2959   (if p4-do-find-file
2960       (progn
2961         (setq p4-vc-check (p4-is-vc file-mode-cache))
2962         (if p4-vc-check
2963             (progn
2964               (p4-menu-add)
2965               (setq p4-mode (concat " P4:" p4-vc-check))))
2966         (p4-force-mode-line-update)
2967         (let ((buffile (p4-buffer-file-name))
2968               (bufname (buffer-name)))
2969           (if (and p4-vc-check (not (member (list buffile bufname)
2970                                             p4-all-buffer-files)))
2971               (add-to-list 'p4-all-buffer-files (list buffile bufname))))
2972         (if (and (not p4-file-refresh-timer) (not (= p4-file-refresh-timer-time 0)))
2973             (setq p4-file-refresh-timer
2974                   (cond (p4-running-emacs
2975                          (run-at-time nil p4-file-refresh-timer-time
2976                                       'p4-refresh-files-in-buffers))
2977                         (p4-running-xemacs
2978                          (add-timeout p4-file-refresh-timer-time
2979                                       'p4-refresh-files-in-buffers nil
2980                                       p4-file-refresh-timer-time)))))
2981         ;; run hooks
2982         (and p4-vc-check (run-hooks 'p4-mode-hook))
2983         p4-vc-check)))
2984
2985 (defun p4-refresh-files-in-buffers (&optional arg)
2986   "Check to see if all the files that are under P4 version control are
2987 actually up-to-date, if in buffers, or need refreshing."
2988   (interactive)
2989   (let ((p4-all-my-files p4-all-buffer-files) buffile bufname thiselt)
2990     (while p4-all-my-files
2991       (setq thiselt (car p4-all-my-files))
2992       (setq p4-all-my-files (cdr p4-all-my-files))
2993       (setq buffile (car thiselt))
2994       (setq bufname (cadr thiselt))
2995       (if (buffer-live-p (get-buffer bufname))
2996           (save-excursion
2997             (let ((buf (get-buffer bufname)))
2998               (set-buffer buf)
2999               (if p4-auto-refresh
3000                   (if (not (buffer-modified-p buf))
3001                       (if (not (verify-visited-file-modtime buf))
3002                           (if (file-readable-p buffile)
3003                               (revert-buffer t t)
3004                             (p4-check-mode))))
3005                 (if (file-readable-p buffile)
3006                     (find-file-noselect buffile t)
3007                   (p4-check-mode)))
3008               (setq buffer-read-only (not (file-writable-p
3009                                            (p4-buffer-file-name))))))
3010         (p4-refresh-refresh-list buffile bufname)))))
3011
3012 (defun p4-check-mode-all-buffers ()
3013   "Call p4-check-mode for all buffers under P4 version control"
3014   (let ((p4-all-my-files p4-all-buffer-files) buffile bufname thiselt
3015         file-mode-cache)
3016     (if (and p4-all-my-files p4-do-find-file)
3017         (setq file-mode-cache
3018               (append (p4-get-add-branch-files)
3019                       (p4-get-have-files (mapcar 'car p4-all-my-files)))))
3020     (while p4-all-my-files
3021       (setq thiselt (car p4-all-my-files))
3022       (setq p4-all-my-files (cdr p4-all-my-files))
3023       (setq buffile (car thiselt))
3024       (setq bufname (cadr thiselt))
3025       (if (buffer-live-p (get-buffer bufname))
3026           (save-excursion
3027             (set-buffer (get-buffer bufname))
3028             (p4-check-mode file-mode-cache))
3029         (p4-refresh-refresh-list buffile bufname)))))
3030
3031 ;; Force mode line updation for different Emacs versions
3032 (defun p4-force-mode-line-update ()
3033   "To Force the mode line update for different flavors of Emacs."
3034   (cond (p4-running-xemacs
3035          (redraw-modeline))
3036         (p4-running-emacs
3037          (force-mode-line-update))))
3038
3039 ;; In case, the P4 server is not available, or when operating off-line, the
3040 ;; p4-find-file-hook becomes a pain... this functions toggles the use of the
3041 ;; hook when opening files.
3042
3043 (defun p4-toggle-vc-mode ()
3044   "In case, the P4 server is not available, or when working off-line, toggle
3045 the VC check on/off when opening files."
3046   (interactive)
3047   (setq p4-do-find-file (not p4-do-find-file))
3048   (message (concat "P4 mode check " (if p4-do-find-file
3049                                         "enabled."
3050                                       "disabled."))))
3051
3052 ;; Wrap C-x C-q to allow p4-edit/revert and also to ensure that
3053 ;; we don't stomp on vc-toggle-read-only.
3054
3055 (defun p4-toggle-read-only (&optional arg)
3056   "If p4-mode is non-nil, \\[p4-toggle-read-only] toggles between `p4-edit'
3057 and `p4-revert'. If ARG is non-nil, p4-offline-mode will be enabled for this
3058 buffer before the toggling takes place. In p4-offline-mode, toggle between
3059 making the file writable and write protected."
3060   (interactive "P")
3061   (if (and arg p4-mode)
3062       (setq p4-mode nil
3063             p4-offline-mode t))
3064   (cond
3065    (p4-mode
3066     (if buffer-read-only
3067         (p4-edit p4-verbose)
3068       (p4-revert p4-verbose)))
3069    (p4-offline-mode
3070     (toggle-read-only)
3071     (if buffer-file-name
3072         (let ((mode (file-modes buffer-file-name)))
3073           (if buffer-read-only
3074               (setq mode (logand mode (lognot 128)))
3075             (setq mode (logior mode 128)))
3076           (set-file-modes buffer-file-name mode))))))
3077
3078 (defun p4-browse-web-page ()
3079   "Browse the p4.el web page."
3080   (interactive)
3081   (require 'browse-url)
3082   (browse-url p4-web-page))
3083
3084 (defun p4-bug-report ()
3085   (interactive)
3086   (if (string-match " 19\\." (emacs-version))
3087       ;; unfortunately GNU Emacs 19.x doesn't have compose-mail
3088       (mail nil p4-emacs-maintainer (concat "BUG REPORT: "
3089                                             (p4-emacs-version)))
3090     (compose-mail p4-emacs-maintainer (concat "BUG REPORT: "
3091                                               (p4-emacs-version))))
3092   (goto-char (point-min))
3093   (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n"))
3094   ;; Insert warnings for novice users.
3095   (insert
3096    "This bug report will be sent to the P4-Emacs Integration Maintainer,\n"
3097    p4-emacs-maintainer "\n\n")
3098   (insert (concat (emacs-version) "\n\n"))
3099   (insert "A brief description of the problem and how to reproduce it:\n")
3100   (save-excursion
3101     (let ((message-buf (get-buffer
3102                         (cond (p4-running-xemacs " *Message-Log*")
3103                               (p4-running-emacs "*Messages*")))))
3104       (if message-buf
3105           (let (beg-pos
3106                 (end-pos (point-max)))
3107             (save-excursion
3108               (set-buffer message-buf)
3109               (goto-char end-pos)
3110               (forward-line -10)
3111               (setq beg-pos (point)))
3112             (insert "\n\nRecent messages:\n")
3113             (insert-buffer-substring message-buf beg-pos end-pos))))))
3114
3115 (defun p4-describe-bindings ()
3116   "A function to list the key bindings for the p4 prefix map"
3117   (interactive)
3118   (save-excursion
3119     (p4-push-window-config)
3120     (let ((map (make-sparse-keymap))
3121           (p4-bindings-buffer "*P4 key bindings*"))
3122       (get-buffer-create p4-bindings-buffer)
3123       (cond
3124        (p4-running-xemacs
3125         (set-buffer p4-bindings-buffer)
3126         (delete-region (point-min) (point-max))
3127         (insert "Key Bindings for P4 Mode\n------------------------\n")
3128         (describe-bindings-internal p4-prefix-map))
3129        (p4-running-emacs
3130         (kill-buffer p4-bindings-buffer)
3131         (describe-bindings "\C-xp")
3132         (set-buffer "*Help*")
3133         (rename-buffer p4-bindings-buffer)))
3134       (define-key map "q" 'p4-quit-current-buffer)
3135       (use-local-map map)
3136       (display-buffer p4-bindings-buffer))))
3137
3138 ;; Break up a string into a list of words
3139 ;; (p4-make-list-from-string "ab c de  f") -> ("ab" "c" "de" "f")
3140 (defun p4-make-list-from-string (str)
3141   (let (lst)
3142     (while (or (string-match "^ *\"\\([^\"]*\\)\"" str)
3143                (string-match "^ *\'\\([^\']*\\)\'" str)
3144                (string-match "^ *\\([^ ]+\\)" str))
3145       (setq lst (append lst (list (match-string 1 str))))
3146       (setq str (substring str (match-end 0))))
3147     lst))
3148
3149 (defun p4-list-to-string (lst)
3150   (mapconcat (lambda (x) x) lst " "))
3151
3152 ;; Return the file name associated with a buffer. If the real buffer file
3153 ;; name doesn't exist, try special filename tags set in some of the p4
3154 ;; buffers.
3155 (defun p4-buffer-file-name-2 ()
3156   (cond ((p4-buffer-file-name))
3157         ((get-char-property (point) 'link-client-name))
3158         ((get-char-property (point) 'link-depot-name))
3159         ((get-char-property (point) 'block-client-name))
3160         ((get-char-property (point) 'block-depot-name))
3161         ((if (and (fboundp 'dired-get-filename)
3162                   (dired-get-filename nil t))
3163              (p4-follow-link-name (dired-get-filename nil t))))))
3164
3165 (defun p4-buffer-file-name ()
3166   (cond (buffer-file-name
3167          (p4-follow-link-name buffer-file-name))
3168         (t nil)))
3169
3170 (defun p4-follow-link-name (name)
3171   (if p4-follow-symlinks
3172       (file-truename name)
3173     name))
3174
3175 (defvar p4-depot-filespec-history nil
3176   "History for p4-depot filespecs.")
3177
3178 (defvar p4-depot-completion-cache nil
3179   "Cache for `p4-depot-completion'.
3180 It is a list of lists whose car is a filespec and
3181 cdr is the list of anwers")
3182
3183 (defvar p4-branches-history nil
3184   "History for p4 clients.")
3185
3186 (defvar p4-branches-completion-cache nil
3187   "Cache for `p4-depot-completion'.
3188 It is a list of lists whose car is a client and
3189 cdr is the list of answers??")
3190
3191 (defvar p4-clients-history nil
3192   "History for p4 clients.")
3193
3194 (defvar p4-clients-completion-cache nil
3195   "Cache for `p4-depot-completion'.
3196 It is a list of lists whose car is a client and
3197 cdr is the list of answers??")
3198
3199 (defvar p4-jobs-completion-cache nil
3200   "Cache for `p4-depot-completion'.
3201 It is a list of lists whose car is a client and
3202 cdr is the list of answers??")
3203
3204 (defvar p4-labels-history nil
3205   "History for p4 clients.")
3206
3207 (defvar p4-labels-completion-cache nil
3208   "Cache for `p4-depot-completion'.
3209 It is a list of lists whose car is a client and
3210 cdr is the list of answers??")
3211
3212 (defvar p4-users-completion-cache nil
3213   "Cache for `p4-depot-completion'.
3214 It is a list of lists whose car is a client and
3215 cdr is the list of answers??")
3216
3217 (defvar p4-arg-string-history nil
3218   "History for p4 command arguments")
3219
3220 (defun p4-depot-completion-search (filespec cmd)
3221   "Look into `p4-depot-completion-cache' for filespec.
3222 Filespec is the candidate for completion, so the
3223 exact file specification is \"filespec*\".
3224
3225 If found in cache, return a list whose car is FILESPEC and cdr is the list
3226 of matches.
3227 If not found in cache, return nil.
3228 So the 'no match' answer is different from 'not in cache'."
3229   (let ((l (cond
3230             ((equal cmd "branches") p4-branches-completion-cache)
3231             ((equal cmd "clients") p4-clients-completion-cache)
3232             ((equal cmd "dirs") p4-depot-completion-cache)
3233             ((equal cmd "jobs") p4-jobs-completion-cache)
3234             ((equal cmd "labels") p4-labels-completion-cache)
3235             ((equal cmd "users") p4-users-completion-cache)))
3236         dir list)
3237
3238     (if (and p4-cleanup-cache (not p4-timer))
3239         (setq p4-timer (cond (p4-running-emacs
3240                               (run-at-time p4-cleanup-time nil
3241                                            'p4-cache-cleanup))
3242                              (p4-running-xemacs
3243                               (add-timeout p4-cleanup-time 'p4-cache-cleanup
3244                                            nil nil)))))
3245     (while l
3246       (if (string-match (concat "^" (car (car l)) "[^/]*$") filespec)
3247           (progn
3248             ;; filespec is included in cache
3249             (if (string= (car (car l)) filespec)
3250                 (setq list (cdr (car l)))
3251               (setq dir (cdr (car l)))
3252               (while dir
3253                 (if (string-match (concat "^" filespec) (car dir))
3254                     (setq list (cons (car dir) list)))
3255                 (setq dir (cdr dir))))
3256             (setq l nil
3257                   list (cons filespec list))))
3258       (setq l (cdr l)))
3259     list))
3260
3261 (defun p4-cache-cleanup (&optional arg)
3262   "Cleanup all the completion caches."
3263   (message "Cleaning up the p4 caches ...")
3264   (setq p4-branches-completion-cache nil)
3265   (setq p4-clients-completion-cache nil)
3266   (setq p4-depot-completion-cache nil)
3267   (setq p4-jobs-completion-cache nil)
3268   (setq p4-labels-completion-cache nil)
3269   (setq p4-users-completion-cache nil)
3270   (if (and p4-running-emacs (timerp p4-timer)) (cancel-timer p4-timer))
3271   (if (and p4-running-xemacs p4-timer) (disable-timeout p4-timer))
3272   (setq p4-timer nil)
3273   (message "Cleaning up the p4 caches ... done."))
3274
3275 (defun p4-partial-cache-cleanup (type)
3276   "Cleanup a specific completion cache."
3277   (cond ((string= type "branch")
3278          (setq p4-branches-completion-cache nil))
3279         ((string= type "client")
3280          (setq p4-clients-completion-cache nil))
3281         ((or (string= type "submit") (string= type "change"))
3282          (setq p4-depot-completion-cache nil))
3283         ((string= type "job")
3284          (setq p4-jobs-completion-cache nil))
3285         ((string= type "label")
3286          (setq p4-labels-completion-cache nil))
3287         ((string= type "user")
3288          (setq p4-users-completion-cache nil))))
3289
3290 (defun p4-read-depot-output (buffer &optional regexp)
3291   "Reads first line of BUFFER and returns it.
3292 Read lines are deleted from buffer.
3293
3294 If optional REGEXP is passed in, return the substring of the first line that
3295 matched the REGEXP."
3296
3297   (save-excursion
3298     (set-buffer buffer)
3299     (goto-char (point-min))
3300     (forward-line)
3301
3302     (let ((line (buffer-substring (point-min) (point))))
3303       (if (string= line "")
3304           nil
3305         (delete-region (point-min) (point))
3306         (if (and regexp (string-match regexp line))
3307             (setq line (substring line (match-beginning 1) (match-end 1))))
3308
3309         ;; remove trailing newline
3310         (if (equal (substring line (1- (length line)) (length line)) "\n")
3311             (substring line 0 (1- (length line)))
3312           line)))))
3313
3314 (defun p4-completion-helper (filespec cmd var regexp)
3315   (let (output-buffer line list)
3316     (message "Making %s completion list..." cmd)
3317     (setq output-buffer (p4-depot-output cmd))
3318     (while (setq line (p4-read-depot-output
3319                        output-buffer regexp))
3320       (if line
3321           (setq list (cons line list))))
3322     (kill-buffer output-buffer)
3323     (set var
3324          (cons (cons filespec list) (eval var)))
3325     list))
3326
3327 (defun p4-depot-completion-build (filespec cmd)
3328   "Ask Perforce for a list of files and directories beginning with FILESPEC."
3329   (let (output-buffer line list)
3330     (cond
3331      ((equal cmd "branches")
3332       (setq list (p4-completion-helper
3333                   filespec cmd 'p4-branches-completion-cache
3334                   "^Branch \\([^ \n]*\\) [0-9][0-9][0-9][0-9]/.*$")))
3335      ((equal cmd "clients")
3336       (setq list (p4-completion-helper
3337                   filespec cmd 'p4-clients-completion-cache
3338                   "^Client \\([^ \n]*\\) [0-9][0-9][0-9][0-9]/.*$")))
3339
3340      ((equal cmd "dirs")
3341       (message "Making p4 completion list...")
3342       (setq output-buffer (p4-depot-output cmd
3343                                            (list (concat filespec "*"))))
3344       (while (setq line (p4-read-depot-output output-buffer))
3345         (if (not (string-match "no such file" line))
3346             (setq list (cons (concat line "/") list))))
3347       (kill-buffer output-buffer)
3348       (setq output-buffer (p4-depot-output "files"
3349                                            (list (concat filespec "*"))))
3350       (while (setq line (p4-read-depot-output output-buffer))
3351         (if (string-match "^\\(.+\\)#[0-9]+ - " line)
3352             (setq list (cons (match-string 1 line) list))))
3353       (kill-buffer output-buffer)
3354       (setq p4-depot-completion-cache
3355             (cons (cons filespec list) p4-depot-completion-cache)))
3356
3357      ((equal cmd "jobs")
3358       (setq list (p4-completion-helper
3359                   filespec cmd 'p4-jobs-completion-cache
3360                   "\\([^ \n]*\\) on [0-9][0-9][0-9][0-9]/.*$")))
3361      ((equal cmd "labels")
3362       (setq list (p4-completion-helper
3363                   filespec cmd 'p4-labels-completion-cache
3364                   "^Label \\([^ \n]*\\) [0-9][0-9][0-9][0-9]/.*$")))
3365      ((equal cmd "users")
3366       (setq list (p4-completion-helper
3367                   filespec cmd 'p4-users-completion-cache
3368                   "^\\([^ ]+\\).*$"))))
3369     (message nil)
3370     (cons filespec list)))
3371
3372 (defun p4-completion-builder (type)
3373   `(lambda (string predicate action)
3374      ,(concat "Completion function for Perforce " type ".
3375
3376 Using the mouse in completion buffer on a client will select it
3377 and exit, unlike standard selection. This is because
3378 `choose-completion-string' (in simple.el) has a special code for
3379 file name selection.")
3380      (let (list)
3381        ,(if (string= type "dirs")
3382             ;; when testing for an exact match, remove trailing /
3383             `(if (and (eq action 'lambda)
3384                       (eq (aref string (1- (length string))) ?/))
3385                  (setq string (substring string 0 (1- (length string))))))
3386
3387        ;; First, look in cache
3388        (setq list (p4-depot-completion-search string ,type))
3389
3390        ;; If not found in cache, build list.
3391        (if (not list)
3392            (setq list (p4-depot-completion-build string ,type)))
3393
3394        (cond
3395         ;; try completion
3396         ((null action)
3397          (try-completion string (mapcar 'list (cdr list)) predicate))
3398         ;; all completions
3399         ((eq action t)
3400          (let ((lst
3401                 (all-completions string (mapcar 'list (cdr list)) predicate)))
3402            ,(if (string= type "dirs")
3403                 `(setq lst (mapcar (lambda (s)
3404                                      (if (string-match ".*/\\(.+\\)" s)
3405                                          (match-string 1 s)
3406                                        s))
3407                                    lst)))
3408            lst))
3409         ;; Test for an exact match
3410         (t
3411          (and (>= (length list) 2)
3412               (member (car list) (cdr list))))))))
3413
3414 (defalias 'p4-branches-completion (p4-completion-builder "branches"))
3415 (defalias 'p4-clients-completion (p4-completion-builder "clients"))
3416 (defalias 'p4-depot-completion (p4-completion-builder "dirs"))
3417 (defalias 'p4-jobs-completion (p4-completion-builder "jobs"))
3418 (defalias 'p4-labels-completion (p4-completion-builder "labels"))
3419 (defalias 'p4-users-completion (p4-completion-builder "users"))
3420
3421
3422 (defun p4-read-arg-string (prompt &optional initial type)
3423   (let ((minibuffer-local-completion-map
3424          (copy-keymap minibuffer-local-completion-map)))
3425     (define-key minibuffer-local-completion-map " " 'self-insert-command)
3426     (completing-read prompt
3427                      (cond ((not type)
3428                             'p4-arg-string-completion)
3429                            ((string= type "branch")
3430                             'p4-branch-string-completion)
3431                            ((string= type "client")
3432                             'p4-client-string-completion)
3433                            ((string= type "label")
3434                             'p4-label-string-completion)
3435                            ((string= type "job")
3436                             'p4-job-string-completion)
3437                            ((string= type "user")
3438                             'p4-user-string-completion))
3439                      nil nil
3440                      initial 'p4-arg-string-history)))
3441
3442 (defun p4-arg-string-completion (string predicate action)
3443   (let ((first-part "") completion)
3444     (if (string-match "^\\(.* +\\)\\(.*\\)" string)
3445         (progn
3446           (setq first-part (match-string 1 string))
3447           (setq string (match-string 2 string))))
3448     (cond ((string-match "-b +$" first-part)
3449            (setq completion (p4-branches-completion string predicate action)))
3450           ((string-match "-t +$" first-part)
3451            (setq completion (p4-list-completion
3452                              string (list "text " "xtext " "binary "
3453                                           "xbinary " "symlink ")
3454                              predicate action)))
3455           ((string-match "-j +$" first-part)
3456            (setq completion (p4-jobs-completion string predicate action)))
3457           ((string-match "-l +$" first-part)
3458            (setq completion (p4-labels-completion string predicate action)))
3459           ((string-match "\\(.*status=\\)\\(.*\\)" string)
3460            (setq first-part (concat first-part (match-string 1 string)))
3461            (setq string (match-string 2 string))
3462            (setq completion (p4-list-completion
3463                              string (list "open " "closed " "suspended ")
3464                              predicate action)))
3465           ((or (string-match "\\(.*@.+,\\)\\(.*\\)" string)
3466                (string-match "\\(.*@\\)\\(.*\\)" string))
3467            (setq first-part (concat first-part (match-string 1 string)))
3468            (setq string (match-string 2 string))
3469            (setq completion (p4-labels-completion string predicate action)))
3470           ((string-match "\\(.*#\\)\\(.*\\)" string)
3471            (setq first-part (concat first-part (match-string 1 string)))
3472            (setq string (match-string 2 string))
3473            (setq completion (p4-list-completion
3474                              string (list "none" "head" "have")
3475                              predicate action)))
3476           ((string-match "^//" string)
3477            (setq completion (p4-depot-completion string predicate action)))
3478           ((string-match "\\(^-\\)\\(.*\\)" string)
3479            (setq first-part (concat first-part (match-string 1 string)))
3480            (setq string (match-string 2 string))
3481            (setq completion (p4-list-completion
3482                              string (list "a " "af " "am " "as " "at " "ay "
3483                                           "b " "c " "d " "dc " "dn "
3484                                           "ds " "du " "e " "f " "i " "j "
3485                                           "l " "m " "n " "q " "r " "s " "sa "
3486                                           "sd " "se " "sr " "t " "v ")
3487                              predicate action)))
3488           (t
3489            (setq completion (p4-file-name-completion string
3490                                                      predicate action))))
3491     (cond ((null action) ;; try-completion
3492            (if (stringp completion)
3493                (concat first-part completion)
3494              completion))
3495           ((eq action t) ;; all-completions
3496            completion)
3497           (t             ;; exact match
3498            completion))))
3499
3500 (defun p4-list-completion (string lst predicate action)
3501   (let ((collection (mapcar 'list lst)))
3502     (cond ((not action)
3503            (try-completion string collection predicate))
3504           ((eq action t)
3505            (all-completions string collection predicate))
3506           (t
3507            (eq (try-completion string collection predicate) t)))))
3508
3509 (defun p4-file-name-completion (string predicate action)
3510   (if (string-match "//\\(.*\\)" string)
3511       (setq string (concat "/" (match-string 1 string))))
3512   (setq string (substitute-in-file-name string))
3513   (setq string (p4-follow-link-name (expand-file-name string)))
3514   (let ((dir-path "") completion)
3515     (if (string-match "^\\(.*[/\\]\\)\\(.*\\)" string)
3516         (progn
3517           (setq dir-path (match-string 1 string))
3518           (setq string (match-string 2 string))))
3519     (cond ((not action)
3520            (setq completion (file-name-completion string dir-path))
3521            (if (stringp completion)
3522                (concat dir-path completion)
3523              completion))
3524           ((eq action t)
3525            (file-name-all-completions string dir-path))
3526           (t
3527            (eq (file-name-completion string dir-path) t)))))
3528
3529 (defun p4-string-completion-builder (completion-function)
3530   `(lambda (string predicate action)
3531      (let ((first-part "") completion)
3532        (if (string-match "^\\(.* +\\)\\(.*\\)" string)
3533            (progn
3534              (setq first-part (match-string 1 string))
3535              (setq string (match-string 2 string))))
3536        (cond ((string-match "^-" string)
3537               (setq completion nil))
3538              (t
3539               (setq completion
3540                     (,completion-function string predicate action))))
3541        (cond ((null action);; try-completion
3542               (if (stringp completion)
3543                   (concat first-part completion)
3544                 completion))
3545              ((eq action t);; all-completions
3546               completion)
3547              (t;; exact match
3548               completion)))))
3549
3550 (defalias 'p4-branch-string-completion (p4-string-completion-builder
3551                                         'p4-branches-completion))
3552
3553 (defalias 'p4-client-string-completion (p4-string-completion-builder
3554                                         'p4-clients-completion))
3555
3556 (defalias 'p4-job-string-completion (p4-string-completion-builder
3557                                      'p4-jobs-completion))
3558
3559 (defalias 'p4-label-string-completion (p4-string-completion-builder
3560                                        'p4-labels-completion))
3561
3562 (defalias 'p4-user-string-completion (p4-string-completion-builder
3563                                       'p4-users-completion))
3564
3565 (defun p4-depot-find-file (file)
3566   (interactive (list (completing-read "Enter filespec: "
3567                                       'p4-depot-completion
3568                                       nil nil
3569                                       p4-default-depot-completion-prefix
3570                                       'p4-depot-filespec-history)))
3571   (let ((lfile (cdar (p4-map-depot-files (list file)))))
3572     (if lfile
3573         (find-file lfile)
3574       (if (get-file-buffer file)
3575           (switch-to-buffer-other-window file)
3576         (get-buffer-create file)
3577         (set-buffer file)
3578         (p4-noinput-buffer-action "print" nil t (list file))
3579         (p4-activate-print-buffer file t)))))
3580
3581
3582 ;; A function to get the current P4 client name
3583 (defun p4-get-client-name ()
3584   "To get the current value of the environment variable P4CLIENT,
3585 type \\[p4-get-client-name].
3586
3587 This will be the current client that is in use for access through
3588 Emacs P4."
3589   (interactive)
3590   (let ((client (p4-current-client)))
3591     (message "P4CLIENT [local: %s], [global: %s]" client (getenv "P4CLIENT"))
3592     client))
3593
3594 (defun p4-get-config-info (file-name token)
3595   (let ((output-buffer (generate-new-buffer p4-output-buffer-name))
3596         (data (getenv token)))
3597     (save-excursion
3598       (set-buffer output-buffer)
3599       (goto-char (point-min))
3600       (insert-file-contents file-name)
3601       (goto-char (point-min))
3602       (if (re-search-forward (concat "^" (regexp-quote token) "=\\(.*\\)")
3603                              nil t)
3604           (setq data (match-string 1))))
3605     (kill-buffer output-buffer)
3606     data))
3607
3608 (defun p4-current-client ()
3609   "Get the current local client, or the global client, if that."
3610   (let ((p4-config-file (p4-find-p4-config-file))
3611         cur-client pmin)
3612     (if (not p4-config-file)
3613         (setq cur-client (getenv "P4CLIENT"))
3614       (setq cur-client (p4-get-config-info p4-config-file "P4CLIENT")))
3615     (if (not cur-client)
3616         (save-excursion
3617           (get-buffer-create p4-output-buffer-name)
3618           (set-buffer p4-output-buffer-name)
3619           (goto-char (point-max))
3620           (setq pmin (point))
3621           (if (zerop (p4-call-p4-here "info"))
3622               (progn
3623                 (goto-char pmin)
3624                 (if (re-search-forward "^Client name:[ \t]+\\(.*\\)$" nil t)
3625                     (setq cur-client (match-string 1)))
3626                 (delete-region pmin (point-max))))))
3627     cur-client))
3628
3629 (defun p4-current-server-port ()
3630   "Get the current local server:port address, or the global server:port, if
3631 that."
3632   (let ((p4-config-file (p4-find-p4-config-file)))
3633     (if (not p4-config-file)
3634         (getenv "P4PORT")
3635       (p4-get-config-info p4-config-file "P4PORT"))))
3636
3637 (defun p4-save-opened-files ()
3638   (get-buffer-create p4-output-buffer-name);; We do these two lines
3639   (kill-buffer p4-output-buffer-name)      ;; to ensure no duplicates
3640   (let ((output-buffer (p4-depot-output "opened"))
3641         opened)
3642     (save-excursion
3643       (set-buffer output-buffer)
3644       (goto-char (point-min))
3645       (while (re-search-forward "^\\(.*\\)#[0-9]+ - " nil t)
3646         (setq opened (cons (match-string 1) opened))))
3647     (kill-buffer output-buffer)
3648     (setq opened (mapcar 'cdr (p4-map-depot-files opened)))
3649     (save-window-excursion
3650       (map-y-or-n-p
3651        (function
3652         (lambda (buffer)
3653           (and (buffer-modified-p buffer)
3654                (not (buffer-base-buffer buffer))
3655                (buffer-file-name buffer)
3656                (member (buffer-file-name buffer) opened)
3657                (format "Save file %s? "
3658                        (buffer-file-name buffer)))))
3659        (function
3660         (lambda (buffer)
3661           (set-buffer buffer)
3662           (save-buffer)))
3663        (buffer-list)
3664        '("buffer" "buffers" "save")))))
3665
3666 (defun p4-empty-diff-p ()
3667   "Return t if there exists a file opened for edit with an empty diff"
3668   (let ((buffer (get-buffer-create "p4-edp-buf"))
3669         opened empty-diff)
3670     (p4-exec-p4 buffer (list "opened") t)
3671     (save-excursion
3672       (set-buffer buffer)
3673       (goto-char (point-min))
3674       (while (re-search-forward "^\\(.*\\)#[0-9]* - edit.*" nil t)
3675         (setq opened (cons (match-string 1) opened))))
3676     (if opened
3677         (progn
3678           (p4-exec-p4 buffer (list "diff") t)
3679           (save-excursion
3680             (set-buffer buffer)
3681             (goto-char (point-max))
3682             (insert "====\n")
3683             (goto-char (point-min))
3684             (while (re-search-forward "^==== \\([^#\n]+\\)#.*\n====" nil t)
3685               (if (member (match-string 1) opened)
3686                   (progn
3687                     (setq empty-diff t)
3688                     (goto-char (point-max))))))))
3689     (kill-buffer buffer)
3690     empty-diff))
3691
3692 (provide 'p4)
3693
3694 ;;; p4.el ends here