You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
7968 lines
283 KiB
7968 lines
283 KiB
;;; clearcase.el --- ClearCase/Emacs integration. |
|
|
|
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2006, 2007 Kevin Esler |
|
|
|
;; Author: Kevin Esler <kaesler@us.ibm.com> |
|
;; Maintainer: Kevin Esler <kaesler@us.ibm.com> |
|
;; Keywords: clearcase tools |
|
;; Web home: http://members.verizon.net/~kevin.a.esler/EmacsClearCase |
|
|
|
;; This file is not part of GNU Emacs. |
|
;; |
|
;; This program is free software; you can redistribute it and/or modify it under |
|
;; the terms of the GNU General Public License as published by the Free Software |
|
;; Foundation; either version 2, or (at your option) any later version. |
|
|
|
;; This program is distributed in the hope that it will be useful, but WITHOUT |
|
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
|
;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more |
|
;; details. |
|
|
|
;; You should have received a copy of the GNU General Public License along with |
|
;; GNU Emacs; see the file COPYING. If not, write to the Free Software |
|
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
|
|
|
;;{{{ Introduction |
|
|
|
;; This is a ClearCase/Emacs integration. |
|
;; |
|
;; |
|
;; How to use |
|
;; ========== |
|
;; |
|
;; 0. Make sure you're using Gnu Emacs-20.4 or later or a recent XEmacs. |
|
;; In general it seems to work better in Gnu Emacs than in XEmacs, |
|
;; although many XEmacs users have no problems at all with it. |
|
;; |
|
;; 1. Make sure that you DON'T load old versions of vc-hooks.el which contain |
|
;; incompatible versions of the tq package (functions tq-enqueue and |
|
;; friends). In particular, Bill Sommerfeld's VC/CC integration has this |
|
;; problem. |
|
;; |
|
;; 2. Copy the files (or at least the clearcase.elc file) to a directory |
|
;; on your emacs-load-path. |
|
;; |
|
;; 3. Insert this in your emacs startup file: (load "clearcase") |
|
;; |
|
;; When you begin editing in any view-context, a ClearCase menu will appear |
|
;; and ClearCase Minor Mode will be activated for you. |
|
;; |
|
;; Summary of features |
|
;; =================== |
|
;; |
|
;; Keybindings compatible with Emacs' VC (where it makes sense) |
|
;; Richer interface than VC |
|
;; Works on NT and Unix |
|
;; Context sensitive menu (Emacs knows the ClearCase-status of files) |
|
;; Snapshot view support: update, version comparisons |
|
;; Can use Emacs Ediff for version comparison display |
|
;; Dired Mode: |
|
;; - en masse checkin/out etc |
|
;; - enhanced display |
|
;; - browse version tree |
|
;; Completion of viewnames, version strings |
|
;; Auto starting of views referenced as /view/TAG/.. (or \\view\TAG\...) |
|
;; Emacs for editing comments, config specs |
|
;; Standard ClearCase GUI tools launchable from Emacs menu |
|
;; - version tree browser |
|
;; - project browser |
|
;; - UCM deliver |
|
;; - UCM rebase |
|
;; Operations directly available from Emacs menu/keymap: |
|
;; create-activity |
|
;; set-activity |
|
;; mkelem, |
|
;; checkout |
|
;; checkin, |
|
;; unco, |
|
;; describe |
|
;; list history |
|
;; edit config spec |
|
;; mkbrtype |
|
;; snapshot view update: file, directory, view |
|
;; version comparisons using ediff, diff or GUI |
|
;; find checkouts |
|
;; annotate version |
|
;; et al. |
|
;; |
|
;; Acknowledgements |
|
;; ================ |
|
;; |
|
;; The help of the following is gratefully acknowledged: |
|
;; |
|
;; XEmacs support and other bugfixes: |
|
;; |
|
;; Rod Whitby |
|
;; Adrian Aichner |
|
;; |
|
;; This was a result of examining earlier versions of VC and VC/ClearCase |
|
;; integrations and borrowing freely therefrom. Accordingly, the following |
|
;; are ackowledged as contributors: |
|
;; |
|
;; VC/ClearCase integration authors: |
|
;; |
|
;; Bill Sommerfeld |
|
;; Rod Whitby |
|
;; Andrew Markebo |
|
;; Andy Eskilsson |
|
;; Paul Smith |
|
;; John Kohl |
|
;; Chris Felaco |
|
;; |
|
;; VC authors: |
|
;; |
|
;; Eric S. Raymond |
|
;; Andre Spiegel |
|
;; Sebastian Kremer |
|
;; Richard Stallman |
|
;; Per Cederqvist |
|
;; ttn@netcom.com |
|
;; Andre Spiegel |
|
;; Jonathan Stigelman |
|
;; Steve Baur |
|
;; |
|
;; Other Contributors: |
|
;; |
|
;; Alastair Rankine |
|
;; Andrew Maguire |
|
;; Barnaby Dalton |
|
;; Christian Savard |
|
;; David O'Shea |
|
;; Dee Zsombor |
|
;; Gabor Zoka |
|
;; Jason Rumney |
|
;; Jeff Phillips |
|
;; Justin Vallon |
|
;; Mark Collins |
|
;; Patrik Madison |
|
;; Ram Bhamidipaty |
|
;; Reinhard Hahn |
|
;; Richard Kim |
|
;; Richard Y. Kim |
|
;; Simon Graham |
|
;; Stephen Leake |
|
;; Steven E. Harris |
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
|
|
|
;;}}} |
|
|
|
;;{{{ Version info |
|
|
|
(defconst clearcase-version-stamp "ClearCase-version: </main/laptop/166>") |
|
(defconst clearcase-version (substring clearcase-version-stamp 19)) |
|
|
|
(defun clearcase-maintainer-address () |
|
;; Avoid spam. |
|
;; |
|
(concat "kevin.esler.1989" |
|
"@" |
|
"alum.bu.edu")) |
|
|
|
(defun clearcase-submit-bug-report () |
|
"Submit via mail a bug report on ClearCase Mode" |
|
(interactive) |
|
(and (y-or-n-p "Do you really want to submit a report on ClearCase Mode ? ") |
|
(reporter-submit-bug-report |
|
(clearcase-maintainer-address) |
|
(concat "clearcase.el " clearcase-version) |
|
'( |
|
system-type |
|
system-configuration |
|
emacs-version |
|
clearcase-clearcase-version-installed |
|
clearcase-cleartool-path |
|
clearcase-lt |
|
clearcase-v3 |
|
clearcase-v4 |
|
clearcase-v5 |
|
clearcase-v6 |
|
clearcase-servers-online |
|
clearcase-disable-tq |
|
clearcase-on-cygwin |
|
clearcase-setview-root |
|
clearcase-suppress-vc-within-mvfs |
|
shell-file-name |
|
w32-quote-process-args |
|
)))) |
|
|
|
;;}}} |
|
|
|
;;{{{ Macros |
|
|
|
(defmacro clearcase-when-debugging (&rest forms) |
|
(list 'if 'clearcase-debug (cons 'progn forms))) |
|
|
|
(defmacro clearcase-with-tempfile (filename-var &rest forms) |
|
`(let ((,filename-var (clearcase-utl-tempfile-name))) |
|
(unwind-protect |
|
,@forms |
|
|
|
;; Cleanup. |
|
;; |
|
(if (file-exists-p ,filename-var) |
|
(delete-file ,filename-var))))) |
|
|
|
;;}}} |
|
|
|
;;{{{ Portability |
|
|
|
(defvar clearcase-xemacs-p (string-match "XEmacs" emacs-version)) |
|
|
|
(defvar clearcase-on-mswindows (memq system-type |
|
'(windows-nt ms-windows cygwin cygwin32))) |
|
|
|
(defvar clearcase-on-cygwin (memq system-type '(cygwin cygwin32))) |
|
|
|
(defvar clearcase-sink-file-name |
|
(cond |
|
(clearcase-on-cygwin "/dev/null") |
|
(clearcase-on-mswindows "NUL") |
|
(t "/dev/null"))) |
|
|
|
(defun clearcase-view-mode-quit (buf) |
|
"Exit from View mode, restoring the previous window configuration." |
|
(progn |
|
(cond ((frame-property (selected-frame) 'clearcase-view-window-config) |
|
(set-window-configuration |
|
(frame-property (selected-frame) 'clearcase-view-window-config)) |
|
(set-frame-property (selected-frame) 'clearcase-view-window-config nil)) |
|
((not (one-window-p)) |
|
(delete-window))) |
|
(kill-buffer buf))) |
|
|
|
(defun clearcase-view-mode (arg &optional camefrom) |
|
(if clearcase-xemacs-p |
|
(let* ((winconfig (current-window-configuration)) |
|
(was-one-window (one-window-p)) |
|
(buffer-name (buffer-name (current-buffer))) |
|
(clearcase-view-not-visible |
|
(not (and (windows-of-buffer buffer-name) ;shortcut |
|
(memq (selected-frame) |
|
(mapcar 'window-frame |
|
(windows-of-buffer buffer-name))))))) |
|
(when clearcase-view-not-visible |
|
(set-frame-property (selected-frame) |
|
'clearcase-view-window-config winconfig)) |
|
(view-mode camefrom 'clearcase-view-mode-quit) |
|
(setq buffer-read-only nil)) |
|
(view-mode arg))) |
|
|
|
(defun clearcase-port-view-buffer-other-window (buffer) |
|
(if clearcase-xemacs-p |
|
(switch-to-buffer-other-window buffer) |
|
(view-buffer-other-window buffer nil 'kill-buffer))) |
|
|
|
(defun clearcase-dired-sort-by-date () |
|
(if (fboundp 'dired-sort-by-date) |
|
(dired-sort-by-date))) |
|
|
|
;; Copied from emacs-20 |
|
;; |
|
(if (not (fboundp 'subst-char-in-string)) |
|
(defun subst-char-in-string (fromchar tochar string &optional inplace) |
|
"Replace FROMCHAR with TOCHAR in STRING each time it occurs. |
|
Unless optional argument INPLACE is non-nil, return a new string." |
|
(let ((i (length string)) |
|
(newstr (if inplace string (copy-sequence string)))) |
|
(while (> i 0) |
|
(setq i (1- i)) |
|
(if (eq (aref newstr i) fromchar) |
|
(aset newstr i tochar))) |
|
newstr))) |
|
|
|
;;}}} |
|
|
|
;;{{{ Require calls |
|
|
|
;; nyi: we also use these at the moment: |
|
;; -view |
|
;; -ediff |
|
;; -view |
|
;; -dired-sort |
|
|
|
(require 'cl) |
|
(require 'comint) |
|
(require 'dired) |
|
(require 'easymenu) |
|
(require 'executable) |
|
(require 'reporter) |
|
(require 'ring) |
|
(or clearcase-xemacs-p |
|
(require 'timer)) |
|
|
|
;; NT Emacs - doesn't use tq. |
|
;; |
|
(if (not clearcase-on-mswindows) |
|
(require 'tq)) |
|
|
|
;;}}} |
|
|
|
;;{{{ Debugging facilities |
|
|
|
;; Setting this to true will enable some debug code. |
|
;; |
|
(defvar clearcase-debug nil) |
|
|
|
(defun clearcase-trace (string) |
|
(clearcase-when-debugging |
|
(let ((trace-buf (get-buffer "*clearcase-trace*"))) |
|
(if trace-buf |
|
(save-excursion |
|
(set-buffer trace-buf) |
|
(goto-char (point-max)) |
|
(insert string "\n")))))) |
|
|
|
(defun clearcase-enable-tracing () |
|
(interactive) |
|
(setq clearcase-debug t) |
|
(get-buffer-create "*clearcase-trace*")) |
|
|
|
(defun clearcase-disable-tracing () |
|
(interactive) |
|
(setq clearcase-debug nil)) |
|
|
|
(defun clearcase-dump () |
|
(interactive) |
|
(clearcase-utl-populate-and-view-buffer |
|
"*clearcase-dump*" |
|
nil |
|
(function (lambda () |
|
(clearcase-fprop-dump-to-current-buffer) |
|
(clearcase-vprop-dump-to-current-buffer))))) |
|
|
|
(defun clearcase-flush-caches () |
|
(interactive) |
|
(clearcase-fprop-clear-all-properties) |
|
(clearcase-vprop-clear-all-properties)) |
|
|
|
;;}}} |
|
|
|
;;{{{ Customizable variables |
|
|
|
(eval-and-compile |
|
(condition-case nil |
|
(require 'custom) |
|
(error nil)) |
|
(if (and (featurep 'custom) |
|
(fboundp 'custom-declare-variable)) |
|
nil ;; We've got what we needed |
|
;; We have the old custom-library, hack around it! |
|
(defmacro defgroup (&rest args) |
|
nil) |
|
(defmacro defcustom (var value doc &rest args) |
|
(` (defvar (, var) (, value) (, doc)))) |
|
(defmacro defface (face value doc &rest stuff) |
|
`(make-face ,face)) |
|
(defmacro custom-declare-variable (symbol value doc &rest args) |
|
(list 'defvar (eval symbol) value doc)))) |
|
|
|
(defgroup clearcase () "ClearCase Options" :group 'tools :prefix "clearcase") |
|
|
|
(defcustom clearcase-keep-uncheckouts t |
|
"When true, the contents of an undone checkout will be kept in a file |
|
with a \".keep\" suffix. Otherwise it will be removed." |
|
:group 'clearcase |
|
:type 'boolean) |
|
|
|
(defcustom clearcase-keep-unhijacks t |
|
"When true, the contents of an undone hijack will be kept in a file |
|
with a \".keep\" suffix. Otherwise it will be removed." |
|
:group 'clearcase |
|
:type 'boolean) |
|
|
|
;; nyi: We could also allow a value of 'prompt here |
|
;; |
|
(defcustom clearcase-set-to-new-activity t |
|
"*If this variable is non-nil when a new activity is created, that activity |
|
will be set as the current activity for the view, otherwise no change is made |
|
to the view's current activity setting." |
|
:group 'clearcase |
|
:type 'boolean) |
|
|
|
(defcustom clearcase-prompt-for-activity-names t |
|
"*If this variable is non-nil the user will be prompted for activity names. |
|
Otherwise, activity names will be generated automatically and will typically |
|
have the form \"activity011112.155233\". If the name entered is empty sucn an |
|
internal name will also be generated." |
|
:group 'clearcase |
|
:type 'boolean) |
|
|
|
(defcustom clearcase-make-backup-files nil |
|
"*If non-nil, backups of ClearCase files are made as with other files. |
|
If nil (the default), files under ClearCase control don't get backups." |
|
:group 'clearcase |
|
:type 'boolean) |
|
|
|
(defcustom clearcase-complete-viewtags t |
|
"*If non-nil, completion on viewtags is enabled. For sites with thousands of view |
|
this should be set to nil." |
|
:group 'clearcase |
|
:type 'boolean) |
|
|
|
(defcustom clearcase-minimise-menus nil |
|
"*If non-nil, menus will hide rather than grey-out inapplicable choices." |
|
:group 'clearcase |
|
:type 'boolean) |
|
|
|
(defcustom clearcase-auto-dired-mode t |
|
"*If non-nil, automatically enter `clearcase-dired-mode' in dired-mode |
|
for directories in ClearCase." |
|
:group 'clearcase |
|
:type 'boolean) |
|
|
|
(defcustom clearcase-dired-highlight t |
|
"If non-nil, highlight reserved files in clearcase-dired buffers." |
|
:group 'clearcase |
|
:type 'boolean) |
|
|
|
(defcustom clearcase-dired-show-view t |
|
"If non-nil, show the view tag in dired buffers." |
|
:group 'clearcase |
|
:type 'boolean) |
|
|
|
(defcustom clearcase-verify-pre-mkelem-dir-checkout nil |
|
"*If non-nil, prompt before checking out the containing directory |
|
before creating a new ClearCase element." |
|
:group 'clearcase |
|
:type 'boolean) |
|
|
|
(defcustom clearcase-diff-on-checkin nil |
|
"Display diff on checkin to help you compose the checkin comment." |
|
:group 'clearcase |
|
:type 'boolean) |
|
|
|
;; General customization |
|
|
|
(defcustom clearcase-suppress-confirm nil |
|
"If non-nil, treat user as expert; suppress yes-no prompts on some things." |
|
:group 'clearcase |
|
:type 'boolean) |
|
|
|
(defcustom clearcase-initial-mkelem-comment nil |
|
"Prompt for initial comment when an element is created." |
|
:group 'clearcase |
|
:type 'boolean) |
|
|
|
(defcustom clearcase-command-messages nil |
|
"Display run messages from back-end commands." |
|
:group 'clearcase |
|
:type 'boolean) |
|
|
|
(defcustom clearcase-checkin-arguments |
|
;; For backwards compatibility with old name for this variable: |
|
;; |
|
(if (and (boundp 'clearcase-checkin-switches) |
|
(not (null clearcase-checkin-switches))) |
|
(list clearcase-checkin-switches) |
|
nil) |
|
"A list of extra arguments passed to the checkin command." |
|
:group 'clearcase |
|
:type '(repeat (string :tag "Argument"))) |
|
|
|
(defcustom clearcase-checkin-on-mkelem nil |
|
"If t, file will be checked-in when first created as an element." |
|
:group 'clearcase |
|
:type 'boolean) |
|
|
|
(defcustom clearcase-suppress-checkout-comments nil |
|
"Suppress prompts for checkout comments for those version control |
|
systems which use them." |
|
:group 'clearcase |
|
:type 'boolean) |
|
|
|
(defcustom clearcase-checkout-arguments |
|
;; For backwards compatibility with old name for this variable: |
|
;; |
|
(if (and (boundp 'clearcase-checkout-arguments) |
|
(not (null clearcase-checkout-arguments))) |
|
(list clearcase-checkout-arguments) |
|
nil) |
|
"A list of extra arguments passed to the checkout command." |
|
:group 'clearcase |
|
:type '(repeat (string :tag "Argument"))) |
|
|
|
(defcustom clearcase-directory-exclusion-list '("lost+found") |
|
"Directory names ignored by functions that recursively walk file trees." |
|
:group 'clearcase |
|
:type '(repeat (string :tag "Subdirectory"))) |
|
|
|
(defcustom clearcase-use-normal-diff nil |
|
"If non-nil, use normal diff instead of cleardiff." |
|
:group 'clearcase |
|
:type 'boolean) |
|
|
|
(defcustom clearcase-normal-diff-program "diff" |
|
"*Program to use for generating the differential of the two files |
|
when `clearcase-use-normal-diff' is t." |
|
:group 'clearcase |
|
:type 'string) |
|
|
|
(defcustom clearcase-normal-diff-arguments |
|
(if (and (boundp 'clearcase-normal-diff-switches) |
|
(not (null clearcase-normal-diff-switches))) |
|
(list clearcase-normal-diff-switches) |
|
(list "-u")) |
|
"A list of extra arguments passed to `clearcase-normal-diff-program' |
|
when `clearcase-use-normal-diff' is t. Usage of the -u switch is |
|
recommended to produce unified diffs, when your |
|
`clearcase-normal-diff-program' supports it." |
|
:group 'clearcase |
|
:type '(repeat (string :tag "Argument"))) |
|
|
|
(defcustom clearcase-vxpath-glue "@@" |
|
"The string used to construct version-extended pathnames." |
|
:group 'clearcase |
|
:type 'string) |
|
|
|
(defcustom clearcase-viewroot (if clearcase-on-mswindows |
|
"//view" |
|
"/view") |
|
"The ClearCase viewroot directory." |
|
:group 'clearcase |
|
:type 'file) |
|
|
|
(defcustom clearcase-viewroot-drive "m:" |
|
"The ClearCase viewroot drive letter for Windows." |
|
:group 'clearcase |
|
:type 'string) |
|
|
|
(defcustom clearcase-suppress-vc-within-mvfs t |
|
"Suppresses VC activity within the MVFS." |
|
:group 'clearcase |
|
:type 'boolean) |
|
|
|
(defcustom clearcase-hide-rebase-activities t |
|
"Hide rebase activities from activity selection list." |
|
:group 'clearcase |
|
:type 'boolean) |
|
|
|
(defcustom clearcase-rebase-id-regexp "^rebase\\." |
|
"The regexp used to detect rebase actvities." |
|
:group 'clearcase |
|
:type 'string) |
|
|
|
;;}}} |
|
|
|
;;{{{ Global variables |
|
|
|
(if (not (boundp 'directory-sep-char)) |
|
(setq directory-sep-char ?/)) |
|
|
|
;; Initialize clearcase-pname-sep-regexp according to |
|
;; directory-sep-char. |
|
(defvar clearcase-pname-sep-regexp |
|
(format "[%s/]" |
|
(char-to-string directory-sep-char))) |
|
|
|
(defvar clearcase-non-pname-sep-regexp |
|
(format "[^%s/]" |
|
(char-to-string directory-sep-char))) |
|
|
|
;; Matches any viewtag (without the trailing "/"). |
|
;; |
|
(defvar clearcase-viewtag-regexp |
|
(concat "^" |
|
clearcase-viewroot |
|
clearcase-pname-sep-regexp |
|
"\\(" |
|
clearcase-non-pname-sep-regexp "*" |
|
"\\)" |
|
"$" |
|
)) |
|
|
|
;; Matches ANY viewroot-relative path |
|
;; |
|
(defvar clearcase-vrpath-regexp |
|
(concat "^" |
|
clearcase-viewroot |
|
clearcase-pname-sep-regexp |
|
"\\(" |
|
clearcase-non-pname-sep-regexp "*" |
|
"\\)" |
|
)) |
|
|
|
;;}}} |
|
|
|
;;{{{ Minor Mode: ClearCase |
|
|
|
;; For ClearCase Minor Mode |
|
;; |
|
(defvar clearcase-mode nil) |
|
(set-default 'clearcase-mode nil) |
|
(make-variable-buffer-local 'clearcase-mode) |
|
(put 'clearcase-mode 'permanent-local t) |
|
|
|
;; Tell Emacs about this new kind of minor mode |
|
;; |
|
(if (not (assoc 'clearcase-mode minor-mode-alist)) |
|
(setq minor-mode-alist (cons '(clearcase-mode clearcase-mode) |
|
minor-mode-alist))) |
|
|
|
;; For now we override the bindings for VC Minor Mode with ClearCase Minor Mode |
|
;; bindings. |
|
;; |
|
(defvar clearcase-mode-map (make-sparse-keymap)) |
|
(defvar clearcase-prefix-map (make-sparse-keymap)) |
|
(define-key clearcase-mode-map "\C-xv" clearcase-prefix-map) |
|
(define-key clearcase-mode-map "\C-x\C-q" 'clearcase-toggle-read-only) |
|
|
|
(define-key clearcase-prefix-map "b" 'clearcase-browse-vtree-current-buffer) |
|
(define-key clearcase-prefix-map "c" 'clearcase-uncheckout-current-buffer) |
|
(define-key clearcase-prefix-map "e" 'clearcase-edcs-edit) |
|
(define-key clearcase-prefix-map "g" 'clearcase-annotate-current-buffer) |
|
(define-key clearcase-prefix-map "i" 'clearcase-mkelem-current-buffer) |
|
(define-key clearcase-prefix-map "l" 'clearcase-list-history-current-buffer) |
|
(define-key clearcase-prefix-map "m" 'clearcase-mkbrtype) |
|
(define-key clearcase-prefix-map "u" 'clearcase-uncheckout-current-buffer) |
|
(define-key clearcase-prefix-map "v" 'clearcase-next-action-current-buffer) |
|
(define-key clearcase-prefix-map "w" 'clearcase-what-rule-current-buffer) |
|
(define-key clearcase-prefix-map "=" 'clearcase-diff-pred-current-buffer) |
|
(define-key clearcase-prefix-map "?" 'clearcase-describe-current-buffer) |
|
(define-key clearcase-prefix-map "~" 'clearcase-version-other-window) |
|
|
|
;; To avoid confusion, we prevent VC Mode from being active at all by |
|
;; undefining its keybindings for which ClearCase Mode doesn't yet have an |
|
;; analogue. |
|
;; |
|
(define-key clearcase-prefix-map "a" 'undefined) ;; vc-update-change-log |
|
(define-key clearcase-prefix-map "d" 'undefined) ;; vc-directory |
|
(define-key clearcase-prefix-map "h" 'undefined) ;; vc-insert-headers |
|
(define-key clearcase-prefix-map "m" 'undefined) ;; vc-merge |
|
(define-key clearcase-prefix-map "r" 'undefined) ;; vc-retrieve-snapshot |
|
(define-key clearcase-prefix-map "s" 'undefined) ;; vc-create-snapshot |
|
(define-key clearcase-prefix-map "t" 'undefined) ;; vc-dired-toggle-terse-mode |
|
|
|
;; Associate the map and the minor mode |
|
;; |
|
(or (not (boundp 'minor-mode-map-alist)) |
|
(assq 'clearcase-mode (symbol-value 'minor-mode-map-alist)) |
|
(setq minor-mode-map-alist |
|
(cons (cons 'clearcase-mode clearcase-mode-map) |
|
minor-mode-map-alist))) |
|
|
|
(defun clearcase-mode (&optional arg) |
|
"ClearCase Minor Mode" |
|
|
|
(interactive "P") |
|
|
|
;; Behave like a proper minor-mode. |
|
;; |
|
(setq clearcase-mode |
|
(if (interactive-p) |
|
(if (null arg) |
|
(not clearcase-mode) |
|
|
|
;; Check if the numeric arg is positive. |
|
;; |
|
(> (prefix-numeric-value arg) 0)) |
|
|
|
;; else |
|
;; Use the car if it's a list. |
|
;; |
|
(if (consp arg) |
|
(setq arg (car arg))) |
|
(if (symbolp arg) |
|
(if (null arg) |
|
(not clearcase-mode) ;; toggle mode switch |
|
(not (eq '- arg))) ;; True if symbol is not '- |
|
|
|
;; else |
|
;; assume it's a number and check that. |
|
;; |
|
(> arg 0)))) |
|
|
|
(if clearcase-mode |
|
(easy-menu-add clearcase-menu 'clearcase-mode-map)) |
|
) |
|
|
|
;;}}} |
|
|
|
;;{{{ Minor Mode: ClearCase Dired |
|
|
|
;;{{{ Reformatting the Dired buffer |
|
|
|
;; Create a face for highlighting checked out files in clearcase-dired. |
|
;; |
|
(if (not (memq 'clearcase-dired-checkedout-face (face-list))) |
|
(progn |
|
(make-face 'clearcase-dired-checkedout-face) |
|
(set-face-foreground 'clearcase-dired-checkedout-face "red"))) |
|
|
|
(defun clearcase-dired-insert-viewtag () |
|
(save-excursion |
|
(progn |
|
(goto-char (point-min)) |
|
|
|
;; Only do this if the buffer is not currently narrowed |
|
;; |
|
(if (= 1 (point)) |
|
(let ((viewtag (clearcase-fprop-viewtag (file-truename default-directory)))) |
|
(if viewtag |
|
(progn |
|
(forward-line 1) |
|
(let ((buffer-read-only nil)) |
|
(insert (format " [ClearCase View: %s]\n" viewtag)))))))))) |
|
|
|
(defun clearcase-dired-reformat-buffer () |
|
"Reformats the current dired buffer." |
|
(let* ((checkout-list nil) |
|
(modified-file-info nil) |
|
(hijack-list nil) |
|
(directory default-directory) |
|
subdir |
|
fullpath) |
|
|
|
;; Iterate over each line in the buffer. |
|
;; |
|
;; Important notes: |
|
;; 1. In general, a Dired buffer can contain listings for several |
|
;; directories. We pass though from top to bottom and adjust |
|
;; subdir as we go. |
|
;; 2. Since this is called from dired-after-reading-hook, it can get |
|
;; called on a single-line buffer. In this case there is no subdir, |
|
;; and no checkout-list. We need to call clearcase-fprop-checked-out |
|
;; to test for a checkout. |
|
;; |
|
(save-excursion |
|
(goto-char (point-min)) |
|
(while (not (eobp)) |
|
(cond |
|
|
|
;; Case 1: Look for directory markers |
|
;; |
|
((setq subdir (dired-get-subdir)) |
|
|
|
;; We're at a subdirectory line in the dired buffer. |
|
;; Go and list all checkouts and hijacks in this subdirectory. |
|
;; |
|
(setq modified-file-info (clearcase-dired-list-modified-files subdir)) |
|
(setq checkout-list (nth 0 modified-file-info)) |
|
(setq hijack-list (nth 1 modified-file-info)) |
|
|
|
;; If no checkouts are found, we don't need to check each file, and |
|
;; it's very slow. The checkout-list should contain something so it |
|
;; doesn't attempt to do this. |
|
;; |
|
(if (null checkout-list) |
|
(setq checkout-list '(nil))) |
|
(if (null hijack-list) |
|
(setq hijack-list '(nil))) |
|
(message "Reformatting %s..." subdir)) |
|
|
|
;; Case 2: Look for files (the safest way to get the filename). |
|
;; |
|
((setq fullpath (dired-get-filename nil t)) |
|
|
|
;; Expand it to get rid of . and .. entries. |
|
;; |
|
(setq fullpath (expand-file-name fullpath)) |
|
|
|
(setq fullpath (clearcase-path-canonicalise-slashes fullpath)) |
|
|
|
;; Only modify directory listings of the correct format. |
|
;; We replace the GID field with a checkout indicator. |
|
;; |
|
(if (looking-at |
|
;; (1) (2) (3) (4) |
|
;; -rw-rw-rw- 1 esler 5 28 Feb 2 16:02 foo.el |
|
"..\\([drwxlts-]+ \\) *\\([0-9]+\\) \\([^ ]+\\) *\\([^ ]+ *\\) +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)") |
|
|
|
(let* ((replacement-begin (match-beginning 4)) |
|
(replacement-end (match-end 4)) |
|
|
|
(replacement-length (- replacement-end replacement-begin)) |
|
(checkout-replacement-text (format "CHECKOUT")) |
|
(hijack-replacement-text (format "HIJACK")) |
|
(is-checkout (if checkout-list |
|
(member fullpath checkout-list) |
|
(clearcase-fprop-checked-out fullpath))) |
|
(is-hijack (if hijack-list |
|
(member fullpath hijack-list) |
|
(clearcase-fprop-hijacked fullpath)))) |
|
|
|
;; Highlight the line if the file is checked-out. |
|
;; |
|
(if is-checkout |
|
(progn |
|
;; Replace the GID field with CHECKOUT. |
|
;; |
|
(let ((buffer-read-only nil)) |
|
|
|
;; Pad with replacement text with trailing spaces if necessary. |
|
;; |
|
(if (>= replacement-length (length checkout-replacement-text)) |
|
(setq checkout-replacement-text |
|
(concat checkout-replacement-text |
|
(make-string (- replacement-length (length checkout-replacement-text)) |
|
32)))) |
|
(goto-char replacement-begin) |
|
(delete-char replacement-length) |
|
(insert (substring checkout-replacement-text 0 replacement-length))) |
|
|
|
;; Highlight the checked out files. |
|
;; |
|
(if (fboundp 'put-text-property) |
|
(let ((buffer-read-only nil)) |
|
(put-text-property replacement-begin replacement-end |
|
'face 'clearcase-dired-checkedout-face))) |
|
) |
|
) |
|
|
|
(if is-hijack |
|
(progn |
|
;; Replace the GID field with CHECKOUT. |
|
;; |
|
(let ((buffer-read-only nil)) |
|
|
|
;; Pad with replacement text with trailing spaces if necessary. |
|
;; |
|
(if (>= replacement-length (length hijack-replacement-text)) |
|
(setq hijack-replacement-text |
|
(concat hijack-replacement-text |
|
(make-string (- replacement-length (length hijack-replacement-text)) |
|
32)))) |
|
(goto-char replacement-begin) |
|
(delete-char replacement-length) |
|
(insert (substring hijack-replacement-text 0 replacement-length))) |
|
|
|
;; Highlight the checked out files. |
|
;; |
|
(if (fboundp 'put-text-property) |
|
(let ((buffer-read-only nil)) |
|
(put-text-property replacement-begin replacement-end |
|
'face 'clearcase-dired-checkedout-face))) |
|
) |
|
) |
|
|
|
)))) |
|
(forward-line 1)))) |
|
(message "Reformatting...Done")) |
|
|
|
|
|
(defun clearcase-path-follow-if-vob-slink (path) |
|
(if (clearcase-fprop-file-is-vob-slink-p path) |
|
|
|
;; It's a slink so follow it. |
|
;; |
|
(let ((slink-text (clearcase-fprop-vob-slink-text path))) |
|
(if (file-name-absolute-p slink-text) |
|
slink-text |
|
(concat (file-name-directory path) slink-text))) |
|
|
|
;; Not an slink. |
|
;; |
|
path)) |
|
|
|
;;{{{ Searching for modified files |
|
|
|
;;{{{ Old code |
|
|
|
;; (defun clearcase-dired-list-checkouts (directory) |
|
;; "Returns a list of files checked-out to the current view in DIRECTORY." |
|
|
|
;; ;; Don't bother looking for checkouts in |
|
;; ;; - a history-mode branch-qua-directory |
|
;; ;; - a view-private directory |
|
;; ;; |
|
;; ;; NYI: For now don't run lsco in root of a snapshot because it gives errors. |
|
;; ;; We need to make this smarter. |
|
;; ;; |
|
;; ;; NYI: For a pathname which is a slink to a dir, despite the fact that |
|
;; ;; clearcase-fprop-file-is-version-p returns true, lsco fails on it, |
|
;; ;; with "not an element". Sheesh, surely lsco ought to follow links ? |
|
;; ;; Solution: catch the error and check if the dir is a slink then follow |
|
;; ;; the link and retry the lsco on the target. |
|
;; ;; |
|
;; ;; For now just ignore the error. |
|
;; ;; |
|
;; (if (and (not (clearcase-vxpath-p directory)) |
|
;; (not (eq 'view-private-object (clearcase-fprop-mtype directory))) |
|
;; (clearcase-fprop-file-is-version-p directory)) |
|
|
|
|
|
;; (let* ((ignore (message "Listing ClearCase checkouts...")) |
|
|
|
;; (true-dir-path (file-truename directory)) |
|
|
|
;; ;; Give the directory as an argument so all names will be |
|
;; ;; fullpaths. For some reason ClearCase adds an extra slash if you |
|
;; ;; leave the trailing slash on the directory, so we need to remove |
|
;; ;; it. |
|
;; ;; |
|
;; (native-dir-path (clearcase-path-native (directory-file-name true-dir-path))) |
|
|
|
;; (followed-dir-path (clearcase-path-follow-if-vob-slink native-dir-path)) |
|
|
|
;; ;; Form the command: |
|
;; ;; |
|
;; (cmd (list |
|
;; "lsco" "-cview" "-fmt" |
|
;; (if clearcase-on-mswindows |
|
;; "%n\\n" |
|
;; "'%n\\n'") |
|
|
|
;; followed-dir-path)) |
|
|
|
;; ;; Capture the output: |
|
;; ;; |
|
;; (string (clearcase-path-canonicalise-slashes |
|
;; (apply 'clearcase-ct-cleartool-cmd cmd))) |
|
|
|
;; ;; Split the output at the newlines: |
|
;; ;; |
|
;; (checkout-list (clearcase-utl-split-string-at-char string ?\n))) |
|
|
|
;; ;; Add entries for "." and ".." if they're checked-out. |
|
;; ;; |
|
;; (let* ((entry ".") |
|
;; (path (expand-file-name (concat (file-name-as-directory true-dir-path) |
|
;; entry)))) |
|
;; (if (clearcase-fprop-checked-out path) |
|
;; (setq checkout-list (cons path checkout-list)))) |
|
;; (let* ((entry "..") |
|
;; (path (expand-file-name (concat (file-name-as-directory true-dir-path) |
|
;; entry)))) |
|
;; (if (clearcase-fprop-checked-out path) |
|
;; (setq checkout-list (cons path checkout-list)))) |
|
|
|
;; ;; If DIRECTORY is a vob-slink, checkout list will contain pathnames |
|
;; ;; relative to the vob-slink target rather than to DIRECTORY. Convert |
|
;; ;; them back here. We're making it appear that lsco works on |
|
;; ;; slinks-to-dirs. |
|
;; ;; |
|
;; (if (clearcase-fprop-file-is-vob-slink-p true-dir-path) |
|
;; (let ((re (regexp-quote (file-name-as-directory followed-dir-path)))) |
|
;; (setq checkout-list |
|
;; (mapcar |
|
;; (function |
|
;; (lambda (path) |
|
;; (replace-regexp-in-string re true-dir-path path))) |
|
;; checkout-list)))) |
|
|
|
;; (message "Listing ClearCase checkouts...done") |
|
|
|
;; ;; Return the result. |
|
;; ;; |
|
;; checkout-list) |
|
;; )) |
|
|
|
;; ;; I had believed that this implementation below OUGHT to be faster, having |
|
;; ;; read the code in "ct+lsco". It seemed that "lsco -cview" hit the VOB and |
|
;; ;; listed all checkouts on all elements in the directory, and then filtered by |
|
;; ;; view. I thought it would probably be quicker to run "ct ls -vob_only" and |
|
;; ;; keep the lines that have "[eclipsed by checkout]". However this code |
|
;; ;; actually seemed to run slower. Leave the code here for now so I can test |
|
;; ;; further. |
|
;; ;; |
|
;; (defun clearcase-dired-list-checkouts-experimental (directory) |
|
;; "Returns a list of files checked-out to the current view in DIRECTORY." |
|
|
|
;; ;; Don't bother looking for checkouts in a history-mode listing |
|
;; ;; nor in view-private directories. |
|
;; ;; |
|
;; (if (and (not (clearcase-vxpath-p directory)) |
|
;; (not (eq 'view-private-object (clearcase-fprop-mtype directory)))) |
|
|
|
;; (let* ((ignore (message "Listing ClearCase checkouts...")) |
|
|
|
;; (true-directory (file-truename directory)) |
|
|
|
;; ;; Move temporarily to the directory: |
|
;; ;; |
|
;; (default-directory true-directory) |
|
|
|
;; ;; Form the command: |
|
;; ;; |
|
;; (cmd (list "ls" "-vob_only")) |
|
|
|
;; ;; Capture the output: |
|
;; ;; |
|
;; (string (clearcase-path-canonicalise-slashes |
|
;; (apply 'clearcase-ct-cleartool-cmd cmd))) |
|
|
|
;; ;; Split the output at the newlines: |
|
;; ;; |
|
;; (line-list (clearcase-utl-split-string-at-char string ?\n)) |
|
|
|
;; (checkout-list nil)) |
|
|
|
;; ;; Look for lines of the form: |
|
;; ;; FILENAME@@ [eclipsed by checkout] |
|
;; ;; |
|
;; (mapcar (function |
|
;; (lambda (line) |
|
;; (if (string-match "^\\([^ @]+\\)@@ +\\[eclipsed by checkout\\].*" line) |
|
;; (setq checkout-list (cons (concat |
|
;; ;; Add back directory name to get |
|
;; ;; full pathname. |
|
;; ;; |
|
;; default-directory |
|
;; (substring line |
|
;; (match-beginning 1) |
|
;; (match-end 1))) |
|
;; checkout-list))))) |
|
;; line-list) |
|
|
|
;; ;; Add entries for "." and ".." if they're checked-out. |
|
;; ;; |
|
;; (let* ((entry ".") |
|
;; (path (expand-file-name (concat true-directory entry)))) |
|
;; (if (clearcase-fprop-checked-out path) |
|
;; (setq checkout-list (cons path checkout-list)))) |
|
;; (let* ((entry "..") |
|
;; (path (expand-file-name (concat true-directory entry)))) |
|
;; (if (clearcase-fprop-checked-out path) |
|
;; (setq checkout-list (cons path checkout-list)))) |
|
|
|
;; (message "Listing ClearCase checkouts...done") |
|
|
|
;; ;; Return the result. |
|
;; ;; |
|
;; checkout-list))) |
|
|
|
;; (defun clearcase-dired-list-hijacks (directory) |
|
;; "Returns a list of files hijacked to the current view in DIRECTORY." |
|
|
|
;; ;; Don't bother looking for hijacks in; |
|
;; ;; - a history-mode listing |
|
;; ;; - a in view-private directory |
|
;; ;; - a dynamic view |
|
;; ;; |
|
;; (let* ((true-directory (file-truename directory)) |
|
;; (viewtag (clearcase-fprop-viewtag true-directory))) |
|
|
|
;; (if (and viewtag |
|
;; (not (clearcase-vxpath-p directory)) |
|
;; (not (eq 'view-private-object (clearcase-fprop-mtype directory))) |
|
;; (clearcase-file-would-be-in-snapshot-p true-directory)) |
|
|
|
;; (let* ((ignore (message "Listing ClearCase hijacks...")) |
|
|
|
;; (true-directory (file-truename directory)) |
|
|
|
;; ;; Form the command: |
|
;; ;; |
|
;; (cmd (list |
|
;; "ls" |
|
|
|
;; ;; Give the directory as an argument so all names will be |
|
;; ;; fullpaths. For some reason ClearCase adds an extra slash |
|
;; ;; if you leave the trailing slash on the directory, so we |
|
;; ;; need to remove it. |
|
;; ;; |
|
;; (clearcase-path-native (directory-file-name true-directory)))) |
|
|
|
;; ;; Capture the output: |
|
;; ;; |
|
;; (string (clearcase-path-canonicalise-slashes |
|
;; (apply 'clearcase-ct-cleartool-cmd cmd))) |
|
|
|
;; ;; Split the output at the newlines: |
|
;; ;; |
|
;; (line-list (clearcase-utl-split-string-at-char string ?\n)) |
|
|
|
;; (hijack-list nil)) |
|
|
|
;; (mapcar (function |
|
;; (lambda (line) |
|
;; (if (string-match "^\\([^ @]+\\)@@[^ ]+ \\[hijacked\\].*" line) |
|
;; (setq hijack-list (cons (substring line |
|
;; (match-beginning 1) |
|
;; (match-end 1)) |
|
;; hijack-list))))) |
|
;; line-list) |
|
|
|
;; (message "Listing ClearCase hijacks...done") |
|
|
|
;; ;; Return the result. |
|
;; ;; |
|
;; hijack-list)))) |
|
|
|
;;}}} |
|
|
|
(defun clearcase-dired-list-modified-files (directory) |
|
"Returns a pair of lists of files (checkouts . hijacks) to the current view in DIRECTORY." |
|
|
|
;; Don't bother looking for hijacks in; |
|
;; - a history-mode listing |
|
;; - a in view-private directory |
|
;; - a dynamic view |
|
;; |
|
(let* ((true-directory (file-truename directory)) |
|
(viewtag (clearcase-fprop-viewtag true-directory)) |
|
(snapshot (clearcase-file-would-be-in-snapshot-p true-directory)) |
|
(result '(() ()))) |
|
|
|
(if (and viewtag |
|
(not (clearcase-vxpath-p directory)) |
|
(not (eq 'view-private-object (clearcase-fprop-mtype directory)))) |
|
|
|
(let* ((ignore (message "Listing ClearCase modified files...")) |
|
|
|
(true-directory (file-truename directory)) |
|
|
|
;; Form the command: |
|
;; |
|
(cmd (list |
|
"ls" |
|
|
|
;; Give the directory as an argument so all names will be |
|
;; fullpaths. For some reason ClearCase adds an extra slash |
|
;; if you leave the trailing slash on the directory, so we |
|
;; need to remove it. |
|
;; |
|
(clearcase-path-native (directory-file-name true-directory)))) |
|
|
|
;; Capture the output: |
|
;; |
|
(string (clearcase-path-canonicalise-slashes |
|
(apply 'clearcase-ct-cleartool-cmd cmd))) |
|
|
|
;; Split the output at the newlines: |
|
;; |
|
(line-list (clearcase-utl-split-string-at-char string ?\n)) |
|
|
|
(hijack-list nil) |
|
(checkout-list nil)) |
|
|
|
(mapcar (function |
|
(lambda (line) |
|
(if (string-match "^\\([^ @]+\\)@@[^ ]+ \\[hijacked\\].*" line) |
|
(setq hijack-list (cons (substring line |
|
(match-beginning 1) |
|
(match-end 1)) |
|
hijack-list))) |
|
(if (string-match "^\\([^ @]+\\)@@.+CHECKEDOUT from .*" line) |
|
(setq checkout-list (cons (substring line |
|
(match-beginning 1) |
|
(match-end 1)) |
|
checkout-list))))) |
|
line-list) |
|
|
|
(message "Listing ClearCase modified files...done") |
|
|
|
;; Return the result. |
|
;; |
|
(setq result (list checkout-list hijack-list)))) |
|
result)) |
|
|
|
;;}}} |
|
|
|
;;}}} |
|
|
|
;; For ClearCase Dired Minor Mode |
|
;; |
|
(defvar clearcase-dired-mode nil) |
|
(set-default 'clearcase-dired-mode nil) |
|
(make-variable-buffer-local 'clearcase-dired-mode) |
|
|
|
;; Tell Emacs about this new kind of minor mode |
|
;; |
|
(if (not (assoc 'clearcase-dired-mode minor-mode-alist)) |
|
(setq minor-mode-alist (cons '(clearcase-dired-mode clearcase-dired-mode) |
|
minor-mode-alist))) |
|
|
|
;; For now we override the bindings for VC Minor Mode with ClearCase Dired |
|
;; Minor Mode bindings. |
|
;; |
|
(defvar clearcase-dired-mode-map (make-sparse-keymap)) |
|
(defvar clearcase-dired-prefix-map (make-sparse-keymap)) |
|
(define-key clearcase-dired-mode-map "\C-xv" clearcase-dired-prefix-map) |
|
|
|
(define-key clearcase-dired-prefix-map "b" 'clearcase-browse-vtree-dired-file) |
|
(define-key clearcase-dired-prefix-map "c" 'clearcase-uncheckout-dired-files) |
|
(define-key clearcase-dired-prefix-map "e" 'clearcase-edcs-edit) |
|
(define-key clearcase-dired-prefix-map "i" 'clearcase-mkelem-dired-files) |
|
(define-key clearcase-dired-prefix-map "g" 'clearcase-annotate-dired-file) |
|
(define-key clearcase-dired-prefix-map "l" 'clearcase-list-history-dired-file) |
|
(define-key clearcase-dired-prefix-map "m" 'clearcase-mkbrtype) |
|
(define-key clearcase-dired-prefix-map "u" 'clearcase-uncheckout-dired-files) |
|
(define-key clearcase-dired-prefix-map "v" 'clearcase-next-action-dired-files) |
|
(define-key clearcase-dired-prefix-map "w" 'clearcase-what-rule-dired-file) |
|
(define-key clearcase-dired-prefix-map "=" 'clearcase-diff-pred-dired-file) |
|
(define-key clearcase-dired-prefix-map "~" 'clearcase-version-other-window) |
|
(define-key clearcase-dired-prefix-map "?" 'clearcase-describe-dired-file) |
|
|
|
;; To avoid confusion, we prevent VC Mode from being active at all by |
|
;; undefining its keybindings for which ClearCase Mode doesn't yet have an |
|
;; analogue. |
|
;; |
|
(define-key clearcase-dired-prefix-map "a" 'undefined) ;; vc-update-change-log |
|
(define-key clearcase-dired-prefix-map "d" 'undefined) ;; vc-directory |
|
(define-key clearcase-dired-prefix-map "h" 'undefined) ;; vc-insert-headers |
|
(define-key clearcase-dired-prefix-map "m" 'undefined) ;; vc-merge |
|
(define-key clearcase-dired-prefix-map "r" 'undefined) ;; vc-retrieve-snapshot |
|
(define-key clearcase-dired-prefix-map "s" 'undefined) ;; vc-create-snapshot |
|
(define-key clearcase-dired-prefix-map "t" 'undefined) ;; vc-dired-toggle-terse-mode |
|
|
|
;; Associate the map and the minor mode |
|
;; |
|
(or (not (boundp 'minor-mode-map-alist)) |
|
(assq 'clearcase-dired-mode (symbol-value 'minor-mode-map-alist)) |
|
(setq minor-mode-map-alist |
|
(cons (cons 'clearcase-dired-mode clearcase-dired-mode-map) |
|
minor-mode-map-alist))) |
|
|
|
(defun clearcase-dired-mode (&optional arg) |
|
"The augmented Dired minor mode used in ClearCase directory buffers. |
|
All Dired commands operate normally. Users with checked-out files |
|
are listed in place of the file's owner and group. Keystrokes bound to |
|
ClearCase Mode commands will execute as though they had been called |
|
on a buffer attached to the file named in the current Dired buffer line." |
|
|
|
(interactive "P") |
|
|
|
;; Behave like a proper minor-mode. |
|
;; |
|
(setq clearcase-dired-mode |
|
(if (interactive-p) |
|
(if (null arg) |
|
(not clearcase-dired-mode) |
|
|
|
;; Check if the numeric arg is positive. |
|
;; |
|
(> (prefix-numeric-value arg) 0)) |
|
|
|
;; else |
|
;; Use the car if it's a list. |
|
;; |
|
(if (consp arg) |
|
(setq arg (car arg))) |
|
|
|
(if (symbolp arg) |
|
(if (null arg) |
|
(not clearcase-dired-mode) ;; toggle mode switch |
|
(not (eq '- arg))) ;; True if symbol is not '- |
|
|
|
;; else |
|
;; assume it's a number and check that. |
|
;; |
|
(> arg 0)))) |
|
|
|
(if (not (eq major-mode 'dired-mode)) |
|
(setq clearcase-dired-mode nil)) |
|
|
|
(if (and clearcase-dired-mode clearcase-dired-highlight) |
|
(clearcase-dired-reformat-buffer)) |
|
|
|
(if clearcase-dired-mode |
|
(easy-menu-add clearcase-dired-menu 'clearcase-dired-mode-map)) |
|
) |
|
|
|
;;}}} |
|
|
|
;;{{{ Major Mode: for editing comments. |
|
|
|
;; The major mode function. |
|
;; |
|
(defun clearcase-comment-mode () |
|
"Major mode for editing comments for ClearCase. |
|
|
|
These bindings are added to the global keymap when you enter this mode: |
|
|
|
\\[clearcase-next-action-current-buffer] perform next logical version-control operation on current file |
|
\\[clearcase-mkelem-current-buffer] mkelem the current file |
|
\\[clearcase-toggle-read-only] like next-action, but won't create elements |
|
\\[clearcase-list-history-current-buffer] display change history of current file |
|
\\[clearcase-uncheckout-current-buffer] cancel checkout in buffer |
|
\\[clearcase-diff-pred-current-buffer] show diffs between file versions |
|
\\[clearcase-version-other-window] visit old version in another window |
|
|
|
While you are entering a comment for a version, the following |
|
additional bindings will be in effect. |
|
|
|
\\[clearcase-comment-finish] proceed with check in, ending comment |
|
|
|
Whenever you do a checkin, your comment is added to a ring of |
|
saved comments. These can be recalled as follows: |
|
|
|
\\[clearcase-comment-next] replace region with next message in comment ring |
|
\\[clearcase-comment-previous] replace region with previous message in comment ring |
|
\\[clearcase-comment-search-reverse] search backward for regexp in the comment ring |
|
\\[clearcase-comment-search-forward] search backward for regexp in the comment ring |
|
|
|
Entry to the clearcase-comment-mode calls the value of text-mode-hook, then |
|
the value of clearcase-comment-mode-hook. |
|
|
|
Global user options: |
|
clearcase-initial-mkelem-comment If non-nil, require user to enter a change |
|
comment upon first checkin of the file. |
|
|
|
clearcase-suppress-confirm Suppresses some confirmation prompts, |
|
notably for reversions. |
|
|
|
clearcase-command-messages If non-nil, display run messages from the |
|
actual version-control utilities (this is |
|
intended primarily for people hacking clearcase.el |
|
itself). |
|
" |
|
(interactive) |
|
|
|
;; Major modes are supposed to just (kill-all-local-variables) |
|
;; but we rely on clearcase-parent-buffer already having been set |
|
;; |
|
;;(let ((parent clearcase-parent-buffer)) |
|
;; (kill-all-local-variables) |
|
;; (set (make-local-variable 'clearcase-parent-buffer) parent)) |
|
|
|
(setq major-mode 'clearcase-comment-mode) |
|
(setq mode-name "ClearCase/Comment") |
|
|
|
(set-syntax-table text-mode-syntax-table) |
|
(use-local-map clearcase-comment-mode-map) |
|
(setq local-abbrev-table text-mode-abbrev-table) |
|
|
|
(make-local-variable 'clearcase-comment-operands) |
|
(make-local-variable 'clearcase-comment-ring-index) |
|
|
|
(set-buffer-modified-p nil) |
|
(setq buffer-file-name nil) |
|
(run-hooks 'text-mode-hook 'clearcase-comment-mode-hook)) |
|
|
|
;; The keymap. |
|
;; |
|
(defvar clearcase-comment-mode-map nil) |
|
(if clearcase-comment-mode-map |
|
nil |
|
(setq clearcase-comment-mode-map (make-sparse-keymap)) |
|
(define-key clearcase-comment-mode-map "\M-n" 'clearcase-comment-next) |
|
(define-key clearcase-comment-mode-map "\M-p" 'clearcase-comment-previous) |
|
(define-key clearcase-comment-mode-map "\M-r" 'clearcase-comment-search-reverse) |
|
(define-key clearcase-comment-mode-map "\M-s" 'clearcase-comment-search-forward) |
|
(define-key clearcase-comment-mode-map "\C-c\C-c" 'clearcase-comment-finish) |
|
(define-key clearcase-comment-mode-map "\C-x\C-s" 'clearcase-comment-save) |
|
(define-key clearcase-comment-mode-map "\C-x\C-q" 'clearcase-comment-num-num-error)) |
|
|
|
;; Constants. |
|
;; |
|
(defconst clearcase-comment-maximum-ring-size 32 |
|
"Maximum number of saved comments in the comment ring.") |
|
|
|
;; Variables. |
|
;; |
|
(defvar clearcase-comment-entry-mode nil) |
|
(defvar clearcase-comment-operation nil) |
|
(defvar clearcase-comment-operands) |
|
(defvar clearcase-comment-ring nil) |
|
(defvar clearcase-comment-ring-index nil) |
|
(defvar clearcase-comment-last-match nil) |
|
(defvar clearcase-comment-window-config nil) |
|
|
|
;; In several contexts, this is a local variable that points to the buffer for |
|
;; which it was made (either a file, or a ClearCase dired buffer). |
|
;; |
|
(defvar clearcase-parent-buffer nil) |
|
(defvar clearcase-parent-buffer-name nil) |
|
|
|
;;{{{ Commands and functions |
|
|
|
(defun clearcase-comment-start-entry (uniquifier |
|
prompt |
|
continuation |
|
operands |
|
&optional parent-buffer comment-seed) |
|
|
|
"Accept a comment by popping up a clearcase-comment-mode buffer |
|
with a name derived from UNIQUIFIER, and emitting PROMPT in the minibuffer. |
|
Set the continuation on close to CONTINUATION, which should be apply-ed to a list |
|
formed by appending OPERANDS and the comment-string. |
|
|
|
Optional 5th argument specifies a PARENT-BUFFER to return to when the operation |
|
is complete. |
|
|
|
Optional 6th argument specifies a COMMENT-SEED to insert in the comment buffer for |
|
the user to edit." |
|
|
|
(let ((comment-buffer (get-buffer-create (format "*clearcase-comment-%s*" uniquifier))) |
|
(old-window-config (current-window-configuration)) |
|
(parent (or parent-buffer |
|
(current-buffer)))) |
|
(pop-to-buffer comment-buffer) |
|
|
|
;; Record in buffer-local variables information sufficient to restore |
|
;; window context. |
|
;; |
|
(set (make-local-variable 'clearcase-comment-window-config) old-window-config) |
|
(set (make-local-variable 'clearcase-parent-buffer) parent) |
|
|
|
(clearcase-comment-mode) |
|
(setq clearcase-comment-operation continuation) |
|
(setq clearcase-comment-operands operands) |
|
(if comment-seed |
|
(insert comment-seed)) |
|
(message "%s Type C-c C-c when done." prompt))) |
|
|
|
|
|
(defun clearcase-comment-cleanup () |
|
;; Make sure it ends with newline |
|
;; |
|
(goto-char (point-max)) |
|
(if (not (bolp)) |
|
(newline)) |
|
|
|
;; Remove useless whitespace. |
|
;; |
|
(goto-char (point-min)) |
|
(while (re-search-forward "[ \t]+$" nil t) |
|
(replace-match "")) |
|
|
|
;; Remove trailing newlines, whitespace. |
|
;; |
|
(goto-char (point-max)) |
|
(skip-chars-backward " \n\t") |
|
(delete-region (point) (point-max))) |
|
|
|
(defun clearcase-comment-finish () |
|
"Complete the operation implied by the current comment." |
|
(interactive) |
|
|
|
;;Clean and record the comment in the ring. |
|
;; |
|
(let ((comment-buffer (current-buffer))) |
|
(clearcase-comment-cleanup) |
|
|
|
(if (null clearcase-comment-ring) |
|
(setq clearcase-comment-ring (make-ring clearcase-comment-maximum-ring-size))) |
|
(ring-insert clearcase-comment-ring (buffer-string)) |
|
|
|
;; Perform the operation on the operands. |
|
;; |
|
(if clearcase-comment-operation |
|
(save-excursion |
|
(apply clearcase-comment-operation |
|
(append clearcase-comment-operands (list (buffer-string))))) |
|
(error "No comment operation is pending")) |
|
|
|
;; Return to "parent" buffer of this operation. |
|
;; Remove comment window. |
|
;; |
|
(let ((old-window-config clearcase-comment-window-config)) |
|
(pop-to-buffer clearcase-parent-buffer) |
|
(delete-windows-on comment-buffer) |
|
(kill-buffer comment-buffer) |
|
(if old-window-config (set-window-configuration old-window-config))))) |
|
|
|
(defun clearcase-comment-save-comment-for-buffer (comment buffer) |
|
(save-excursion |
|
(set-buffer buffer) |
|
(let ((file (buffer-file-name))) |
|
(if (clearcase-fprop-checked-out file) |
|
(progn |
|
(clearcase-ct-do-cleartool-command "chevent" |
|
file |
|
comment |
|
(list "-replace")) |
|
(clearcase-fprop-set-comment file comment)) |
|
(error "Can't change comment of checked-in version with this interface"))))) |
|
|
|
(defun clearcase-comment-save () |
|
"Save the currently entered comment" |
|
(interactive) |
|
(let ((comment-string (buffer-string)) |
|
(parent-buffer clearcase-parent-buffer)) |
|
(if (not (buffer-modified-p)) |
|
(message "(No changes need to be saved)") |
|
(progn |
|
(save-excursion |
|
(set-buffer parent-buffer) |
|
(clearcase-comment-save-comment-for-buffer comment-string parent-buffer)) |
|
|
|
(set-buffer-modified-p nil))))) |
|
|
|
(defun clearcase-comment-num-num-error () |
|
(interactive) |
|
(message "Perhaps you wanted to type C-c C-c instead?")) |
|
|
|
;; Code for the comment ring. |
|
;; |
|
(defun clearcase-comment-next (arg) |
|
"Cycle forwards through comment history." |
|
(interactive "*p") |
|
(clearcase-comment-previous (- arg))) |
|
|
|
(defun clearcase-comment-previous (arg) |
|
"Cycle backwards through comment history." |
|
(interactive "*p") |
|
(let ((len (ring-length clearcase-comment-ring))) |
|
(cond ((or (not len) (<= len 0)) |
|
(message "Empty comment ring") |
|
(ding)) |
|
(t |
|
(erase-buffer) |
|
|
|
;; Initialize the index on the first use of this command so that the |
|
;; first M-p gets index 0, and the first M-n gets index -1. |
|
;; |
|
(if (null clearcase-comment-ring-index) |
|
(setq clearcase-comment-ring-index |
|
(if (> arg 0) -1 |
|
(if (< arg 0) 1 0)))) |
|
(setq clearcase-comment-ring-index |
|
(mod (+ clearcase-comment-ring-index arg) len)) |
|
(message "%d" (1+ clearcase-comment-ring-index)) |
|
(insert (ring-ref clearcase-comment-ring clearcase-comment-ring-index)))))) |
|
|
|
(defun clearcase-comment-search-forward (str) |
|
"Searches forwards through comment history for substring match." |
|
(interactive "sComment substring: ") |
|
(if (string= str "") |
|
(setq str clearcase-comment-last-match) |
|
(setq clearcase-comment-last-match str)) |
|
(if (null clearcase-comment-ring-index) |
|
(setq clearcase-comment-ring-index 0)) |
|
(let ((str (regexp-quote str)) |
|
(n clearcase-comment-ring-index)) |
|
(while (and (>= n 0) (not (string-match str (ring-ref clearcase-comment-ring n)))) |
|
(setq n (- n 1))) |
|
(cond ((>= n 0) |
|
(clearcase-comment-next (- n clearcase-comment-ring-index))) |
|
(t (error "Not found"))))) |
|
|
|
(defun clearcase-comment-search-reverse (str) |
|
"Searches backwards through comment history for substring match." |
|
(interactive "sComment substring: ") |
|
(if (string= str "") |
|
(setq str clearcase-comment-last-match) |
|
(setq clearcase-comment-last-match str)) |
|
(if (null clearcase-comment-ring-index) |
|
(setq clearcase-comment-ring-index -1)) |
|
(let ((str (regexp-quote str)) |
|
(len (ring-length clearcase-comment-ring)) |
|
(n (1+ clearcase-comment-ring-index))) |
|
(while (and (< n len) |
|
(not (string-match str (ring-ref clearcase-comment-ring n)))) |
|
(setq n (+ n 1))) |
|
(cond ((< n len) |
|
(clearcase-comment-previous (- n clearcase-comment-ring-index))) |
|
(t (error "Not found"))))) |
|
|
|
;;}}} |
|
|
|
;;}}} |
|
|
|
;;{{{ Major Mode: for editing config-specs. |
|
|
|
;; The major mode function. |
|
;; |
|
(defun clearcase-edcs-mode () |
|
(interactive) |
|
(set-syntax-table text-mode-syntax-table) |
|
(use-local-map clearcase-edcs-mode-map) |
|
(setq major-mode 'clearcase-edcs-mode) |
|
(setq mode-name "ClearCase/edcs") |
|
(make-variable-buffer-local 'clearcase-parent-buffer) |
|
(set-buffer-modified-p nil) |
|
(setq buffer-file-name nil) |
|
(run-hooks 'text-mode-hook 'clearcase-edcs-mode-hook)) |
|
|
|
;; The keymap. |
|
;; |
|
(defvar clearcase-edcs-mode-map nil) |
|
(if clearcase-edcs-mode-map |
|
nil |
|
(setq clearcase-edcs-mode-map (make-sparse-keymap)) |
|
(define-key clearcase-edcs-mode-map "\C-c\C-c" 'clearcase-edcs-finish) |
|
(define-key clearcase-edcs-mode-map "\C-x\C-s" 'clearcase-edcs-save)) |
|
|
|
;; Variables. |
|
;; |
|
(defvar clearcase-edcs-tag-name nil |
|
"Name of view tag which is currently being edited") |
|
|
|
(defvar clearcase-edcs-tag-history () |
|
"History of view tags used in clearcase-edcs-edit") |
|
|
|
;;{{{ Commands |
|
|
|
(defun clearcase-edcs-edit (tag-name) |
|
"Edit a ClearCase configuration specification" |
|
|
|
(interactive |
|
(let ((vxname (clearcase-fprop-viewtag default-directory))) |
|
(if clearcase-complete-viewtags |
|
(list (directory-file-name |
|
(completing-read "View Tag: " |
|
(clearcase-viewtag-all-viewtags-obarray) |
|
nil |
|
;;'fascist |
|
nil |
|
vxname |
|
'clearcase-edcs-tag-history))) |
|
(read-string "View Tag: ")))) |
|
|
|
(let ((start (current-buffer)) |
|
(buffer-name (format "*clearcase-config-spec-%s*" tag-name))) |
|
(kill-buffer (get-buffer-create buffer-name)) |
|
(pop-to-buffer (get-buffer-create buffer-name)) |
|
(auto-save-mode auto-save-default) |
|
(erase-buffer) |
|
(insert (clearcase-ct-cleartool-cmd "catcs" "-tag" tag-name)) |
|
(goto-char (point-min)) |
|
(re-search-forward "^[^#\n]" nil 'end) |
|
(beginning-of-line) |
|
(clearcase-edcs-mode) |
|
(setq clearcase-parent-buffer start) |
|
(make-local-variable 'clearcase-edcs-tag-name) |
|
(setq clearcase-edcs-tag-name tag-name))) |
|
|
|
(defun clearcase-edcs-save () |
|
(interactive) |
|
(if (not (buffer-modified-p)) |
|
(message "Configuration not changed since last saved") |
|
|
|
(message "Setting configuration for %s..." clearcase-edcs-tag-name) |
|
(clearcase-with-tempfile |
|
cspec-text |
|
(write-region (point-min) (point-max) cspec-text nil 'dont-mention-it) |
|
(let ((ret (clearcase-ct-cleartool-cmd "setcs" |
|
"-tag" |
|
clearcase-edcs-tag-name |
|
(clearcase-path-native cspec-text)))) |
|
|
|
;; nyi: we could be smarter and retain viewtag info and perhaps some |
|
;; other info. For now invalidate all cached file property info. |
|
;; |
|
(clearcase-fprop-clear-all-properties) |
|
|
|
(set-buffer-modified-p nil) |
|
(message "Setting configuration for %s...done" |
|
clearcase-edcs-tag-name))))) |
|
|
|
(defun clearcase-edcs-finish () |
|
(interactive) |
|
(let ((old-buffer (current-buffer))) |
|
(clearcase-edcs-save) |
|
(bury-buffer nil) |
|
(kill-buffer old-buffer))) |
|
|
|
;;}}} |
|
|
|
;;}}} |
|
|
|
;;{{{ View browser |
|
|
|
;; nyi: Just an idea now. |
|
;; Be able to present a selection of views at various times |
|
;; - show me current file in other view |
|
;; - top-level browse operation |
|
|
|
;; clearcase-viewtag-started-viewtags gives us the dynamic views that are mounted. |
|
|
|
;; How to find local snapshots ? |
|
|
|
;; How to find drive-letter mount points for view on NT ? |
|
;; - parse "subst" output |
|
|
|
;;}}} |
|
|
|
;;{{{ Commands |
|
|
|
;;{{{ Hijack/unhijack |
|
|
|
(defun clearcase-hijack-current-buffer () |
|
"Hijack the file in the current buffer." |
|
(interactive) |
|
(clearcase-hijack buffer-file-name)) |
|
|
|
(defun clearcase-hijack-dired-files () |
|
"Hijack the selected files." |
|
(interactive) |
|
(clearcase-hijack-seq (dired-get-marked-files))) |
|
|
|
(defun clearcase-unhijack-current-buffer () |
|
"Unhijack the file in the current buffer." |
|
(interactive) |
|
(clearcase-unhijack buffer-file-name)) |
|
|
|
(defun clearcase-unhijack-dired-files () |
|
"Hijack the selected files." |
|
(interactive) |
|
(clearcase-unhijack-seq (dired-get-marked-files))) |
|
|
|
;;}}} |
|
|
|
;;{{{ Annotate |
|
|
|
(defun clearcase-annotate-file (file) |
|
(let ((relative-name (file-relative-name file))) |
|
(message "Annotating %s ..." relative-name) |
|
(clearcase-with-tempfile |
|
annotation-file |
|
(clearcase-ct-do-cleartool-command "annotate" |
|
file |
|
'unused |
|
(list "-nco" |
|
"-out" |
|
annotation-file)) |
|
(clearcase-utl-populate-and-view-buffer |
|
"*clearcase-annotate*" |
|
nil |
|
(function |
|
(lambda () |
|
(insert-file-contents annotation-file))))) |
|
(message "Annotating %s ...done" relative-name))) |
|
|
|
(defun clearcase-annotate-current-buffer () |
|
(interactive) |
|
(clearcase-annotate-file buffer-file-name)) |
|
|
|
(defun clearcase-annotate-dired-file () |
|
"Annotate the selected file." |
|
(interactive) |
|
(clearcase-annotate-file (dired-get-filename))) |
|
|
|
;;}}} |
|
|
|
;;{{{ nyi: Find checkouts |
|
|
|
;; NYI: Enhance this: |
|
;; - group by: |
|
;; - activity name |
|
;; - checkout comment |
|
;; - permit unco/checkin |
|
;; |
|
(defun clearcase-find-checkouts-in-current-view () |
|
"Find the checkouts in all vobs in the current view." |
|
(interactive) |
|
(let ((viewtag (clearcase-fprop-viewtag default-directory)) |
|
(dir default-directory)) |
|
(if viewtag |
|
(let* ((ignore (message "Finding checkouts...")) |
|
(text (clearcase-ct-blocking-call "lsco" |
|
"-cview" |
|
"-avobs" |
|
"-short"))) |
|
(if (zerop (length text)) |
|
(message "No checkouts found") |
|
(progn |
|
(message "Finding checkouts...done") |
|
|
|
(clearcase-utl-populate-and-view-buffer |
|
"*clearcase*" |
|
(list text) |
|
(function (lambda (s) |
|
(insert s)))))))))) |
|
|
|
;;}}} |
|
|
|
;;{{{ UCM operations |
|
|
|
;;{{{ Make activity |
|
|
|
(defun clearcase-read-new-activity-name () |
|
"Read the name of a new activity from the minibuffer. |
|
Return nil if the empty string is entered." |
|
|
|
;; nyi: Probably should check that the activity doesn't already exist. |
|
;; |
|
(let ((entered-name (read-string "Activity name (optional): " ))) |
|
(if (not (zerop (length entered-name))) |
|
entered-name |
|
nil))) |
|
|
|
(defun clearcase-read-mkact-args () |
|
"Read the name and headline arguments for clearcase-ucm-mkact-current-dir |
|
from the minibuffer." |
|
|
|
(let ((name nil) |
|
(headline "")) |
|
(if clearcase-prompt-for-activity-names |
|
(setq name (clearcase-read-new-activity-name))) |
|
(setq headline (read-string "Activity headline: " )) |
|
(list name headline))) |
|
|
|
(defun clearcase-make-internally-named-activity (stream-name comment-file) |
|
"Make a new activity in STREAM-NAME with creation comment in COMMENT-FILE, |
|
and use an internally-generated name for the activity." |
|
|
|
(let ((ret |
|
(if clearcase-set-to-new-activity |
|
(clearcase-ct-blocking-call "mkact" |
|
"-cfile" (clearcase-path-native comment-file) |
|
"-in" stream-name |
|
"-force") |
|
(clearcase-ct-blocking-call "mkact" |
|
"-nset" |
|
"-cfile" (clearcase-path-native comment-file) |
|
"-in" stream-name |
|
"-nset" |
|
"-force")))) |
|
(if (string-match "Created activity \"\\([^\"]+\\)\"" ret) |
|
(substring ret (match-beginning 1) (match-end 1)) |
|
(error "Failed to create activity: %s" ret)))) |
|
|
|
(defun clearcase-ucm-mkact-current-dir (name headline &optional comment) |
|
|
|
"Make an activity with NAME and HEADLINE and optional COMMENT, in the stream |
|
associated with the view associated with the current directory." |
|
|
|
(interactive (clearcase-read-mkact-args)) |
|
(let* ((viewtag (clearcase-fprop-viewtag default-directory)) |
|
(stream (clearcase-vprop-stream viewtag)) |
|
(pvob (clearcase-vprop-pvob viewtag))) |
|
(if (not (clearcase-vprop-ucm viewtag)) |
|
(error "View %s is not a UCM view" viewtag)) |
|
(if (null stream) |
|
(error "View %s has no stream" viewtag)) |
|
(if (null stream) |
|
(error "View %s has no PVOB" viewtag)) |
|
|
|
(if (null comment) |
|
;; If no comment supplied, go and get one.. |
|
;; |
|
(progn |
|
(clearcase-comment-start-entry (format "new-activity-%d" (random)) |
|
"Enter comment for new activity." |
|
'clearcase-ucm-mkact-current-dir |
|
(list name headline))) |
|
;; ...else do the operation. |
|
;; |
|
(message "Making activity...") |
|
(clearcase-with-tempfile |
|
comment-file |
|
(write-region comment nil comment-file nil 'noprint) |
|
(let ((qualified-stream (format "%s@%s" stream pvob))) |
|
(if (stringp name) |
|
(if clearcase-set-to-new-activity |
|
(clearcase-ct-blocking-call "mkact" |
|
"-cfile" (clearcase-path-native comment-file) |
|
"-headline" headline |
|
"-in" qualified-stream |
|
"-force" |
|
name) |
|
(clearcase-ct-blocking-call "mkact" |
|
"-nset" |
|
"-cfile" (clearcase-path-native comment-file) |
|
"-headline" headline |
|
"-in" qualified-stream |
|
"-force" |
|
name)) |
|
(progn |
|
;; If no name was provided we do the creation in two steps: |
|
;; mkact -force |
|
;; chact -headline |
|
;; to make sure we get preferred internally generated activity |
|
;; name of the form "activityNNN.MMM" rather than some horrible |
|
;; concoction based on the headline. |
|
;; |
|
(let ((name (clearcase-make-internally-named-activity qualified-stream comment-file))) |
|
(clearcase-ct-blocking-call "chact" |
|
"-headline" headline |
|
name)))))) |
|
|
|
;; Flush the activities for this view so they'll get refreshed when needed. |
|
;; |
|
(clearcase-vprop-flush-activities viewtag) |
|
|
|
(message "Making activity...done")))) |
|
|
|
;;}}} |
|
|
|
;;{{{ Set activity |
|
|
|
(defun clearcase-ucm-filter-out-rebases (activities) |
|
(if (not clearcase-hide-rebase-activities) |
|
activities |
|
(clearcase-utl-list-filter |
|
(function |
|
(lambda (activity) |
|
(let ((id (car activity))) |
|
(not (string-match clearcase-rebase-id-regexp id))))) |
|
activities))) |
|
|
|
(defun clearcase-ucm-set-activity-current-dir () |
|
(interactive) |
|
(let* ((viewtag (clearcase-fprop-viewtag default-directory))) |
|
(if (not (clearcase-vprop-ucm viewtag)) |
|
(error "View %s is not a UCM view" viewtag)) |
|
;; Filter out the rebases here if the user doesn't want to see them. |
|
;; |
|
(let ((activities (clearcase-ucm-filter-out-rebases (clearcase-vprop-activities viewtag)))) |
|
(if (null activities) |
|
(error "View %s has no activities" viewtag)) |
|
(clearcase-ucm-make-selection-window (format "*clearcase-activity-select-%s*" viewtag) |
|
(mapconcat |
|
(function |
|
(lambda (activity) |
|
(let ((id (car activity)) |
|
(title (cdr activity))) |
|
(format "%s\t%s" id title)))) |
|
activities |
|
"\n") |
|
'clearcase-ucm-activity-selection-interpreter |
|
'clearcase-ucm-set-activity |
|
(list viewtag))))) |
|
|
|
(defun clearcase-ucm-activity-selection-interpreter () |
|
"Extract the activity name from the buffer at point" |
|
(if (looking-at "^\\(.*\\)\t") |
|
(let ((activity-name (buffer-substring (match-beginning 1) |
|
(match-end 1)))) |
|
activity-name) |
|
(error "No activity on this line"))) |
|
|
|
(defun clearcase-ucm-set-activity-none-current-dir () |
|
(interactive) |
|
(let* ((viewtag (clearcase-fprop-viewtag default-directory))) |
|
(if (not (clearcase-vprop-ucm viewtag)) |
|
(error "View %s is not a UCM view" viewtag)) |
|
(clearcase-ucm-set-activity viewtag nil))) |
|
|
|
(defun clearcase-ucm-set-activity (viewtag activity-name) |
|
(if activity-name |
|
;; Set an activity |
|
;; |
|
(progn |
|
(message "Setting activity...") |
|
(let ((qualified-activity-name (if (string-match "@" activity-name) |
|
activity-name |
|
(concat activity-name "@" (clearcase-vprop-pvob viewtag))))) |
|
(clearcase-ct-blocking-call "setactivity" "-nc" "-view" |
|
viewtag |
|
(if qualified-activity-name |
|
qualified-activity-name |
|
"-none"))) |
|
;; Update cache |
|
;; |
|
(clearcase-vprop-set-current-activity viewtag activity-name) |
|
(message "Setting activity...done")) |
|
|
|
;; Set NO activity |
|
;; |
|
(message "Unsetting activity...") |
|
(clearcase-ct-blocking-call "setactivity" |
|
"-nc" |
|
"-view" viewtag |
|
"-none") |
|
;; Update cache |
|
;; |
|
(clearcase-vprop-set-current-activity viewtag nil) |
|
(message "Unsetting activity...done"))) |
|
|
|
;;}}} |
|
|
|
;;{{{ Show current activity |
|
|
|
(defun clearcase-ucm-describe-current-activity () |
|
(interactive) |
|
(let* ((viewtag (clearcase-fprop-viewtag default-directory))) |
|
(if (not viewtag) |
|
(error "Not in a view")) |
|
(if (not (clearcase-vprop-ucm viewtag)) |
|
(error "View %s is not a UCM view" viewtag)) |
|
(let ((pvob (clearcase-vprop-pvob viewtag)) |
|
(current-activity (clearcase-vprop-current-activity viewtag))) |
|
(if (not current-activity) |
|
(message "No activity set") |
|
(let ((text (clearcase-ct-blocking-call "desc" |
|
(concat "activity:" |
|
current-activity |
|
"@" |
|
pvob)))) |
|
(if (not (zerop (length text))) |
|
(clearcase-utl-populate-and-view-buffer |
|
"*clearcase*" |
|
(list text) |
|
(function (lambda (s) |
|
(insert s)))))))))) |
|
;;}}} |
|
|
|
;;}}} |
|
|
|
;;{{{ Next-action |
|
|
|
(defun clearcase-next-action-current-buffer () |
|
"Do the next logical operation on the current file. |
|
Operations include mkelem, checkout, checkin, uncheckout" |
|
(interactive) |
|
(clearcase-next-action buffer-file-name)) |
|
|
|
(defun clearcase-next-action-dired-files () |
|
"Do the next logical operation on the marked files. |
|
Operations include mkelem, checkout, checkin, uncheckout. |
|
If all the files are not in an equivalent state, an error is raised." |
|
|
|
(interactive) |
|
(clearcase-next-action-seq (dired-get-marked-files))) |
|
|
|
(defun clearcase-next-action (file) |
|
(let ((action (clearcase-compute-next-action file))) |
|
(cond |
|
|
|
((eq action 'mkelem) |
|
(clearcase-commented-mkelem file)) |
|
|
|
((eq action 'checkout) |
|
(clearcase-commented-checkout file)) |
|
|
|
((eq action 'uncheckout) |
|
(if (yes-or-no-p "Checked-out file appears unchanged. Cancel checkout ? ") |
|
(clearcase-uncheckout file))) |
|
|
|
((eq action 'illegal-checkin) |
|
(error "This file is checked out by someone else: %s" (clearcase-fprop-user file))) |
|
|
|
((eq action 'checkin) |
|
(clearcase-commented-checkin file)) |
|
|
|
(t |
|
(error "Can't compute suitable next ClearCase action for file %s" file))))) |
|
|
|
(defun clearcase-next-action-seq (files) |
|
"Do the next logical operation on the sequence of FILES." |
|
|
|
;; Check they're all in the same state. |
|
;; |
|
(let ((actions (mapcar (function clearcase-compute-next-action) files))) |
|
(if (not (clearcase-utl-elts-are-eq actions)) |
|
(error "Marked files are not all in the same state")) |
|
(let ((action (car actions))) |
|
(cond |
|
|
|
((eq action 'mkelem) |
|
(clearcase-commented-mkelem-seq files)) |
|
|
|
((eq action 'checkout) |
|
(clearcase-commented-checkout-seq files)) |
|
|
|
((eq action 'uncheckout) |
|
(if (yes-or-no-p "Checked-out files appears unchanged. Cancel checkouts ? ") |
|
(clearcase-uncheckout-seq files))) |
|
|
|
((eq action 'illegal-checkin) |
|
(error "These files are checked out by someone else; will no checkin")) |
|
|
|
((eq action 'checkin) |
|
(clearcase-commented-checkin-seq files)) |
|
|
|
(t |
|
(error "Can't compute suitable next ClearCase action for marked files")))))) |
|
|
|
(defun clearcase-compute-next-action (file) |
|
"Compute the next logical action on FILE." |
|
|
|
(cond |
|
;; nyi: other cases to consider later: |
|
;; |
|
;; - file is unreserved |
|
;; - file is not mastered |
|
|
|
;; Case 1: it is not yet an element |
|
;; ==> mkelem |
|
;; |
|
((clearcase-file-ok-to-mkelem file) |
|
'mkelem) |
|
|
|
;; Case 2: file is not checked out |
|
;; ==> checkout |
|
;; |
|
((clearcase-file-ok-to-checkout file) |
|
'checkout) |
|
|
|
;; Case 3: file is checked-out but not modified in buffer or disk |
|
;; ==> offer to uncheckout |
|
;; |
|
((and (clearcase-file-ok-to-uncheckout file) |
|
(not (file-directory-p file)) |
|
(not (buffer-modified-p)) |
|
(not (clearcase-file-appears-modified-since-checkout-p file))) |
|
'uncheckout) |
|
|
|
;; Case 4: file is checked-out but by somebody else using this view. |
|
;; ==> refuse to checkin |
|
;; |
|
;; This is not reliable on some Windows installations where a user is known |
|
;; as "esler" on Unix and the ClearCase server, and "ESLER" on the Windows |
|
;; client. |
|
;; |
|
((and (not clearcase-on-mswindows) |
|
(clearcase-fprop-checked-out file) |
|
(not (string= (user-login-name) |
|
(clearcase-fprop-user file)))) |
|
'illegal-checkin) |
|
|
|
;; Case 5: user has checked-out the file |
|
;; ==> check it in |
|
;; |
|
((clearcase-file-ok-to-checkin file) |
|
'checkin) |
|
|
|
(t |
|
nil))) |
|
|
|
;;}}} |
|
|
|
;;{{{ Mkelem |
|
|
|
(defun clearcase-mkelem-current-buffer () |
|
"Make the current file into a ClearCase element." |
|
(interactive) |
|
|
|
;; Watch out for new buffers of size 0: the corresponding file |
|
;; does not exist yet, even though buffer-modified-p is nil. |
|
;; |
|
(if (and (not (buffer-modified-p)) |
|
(zerop (buffer-size)) |
|
(not (file-exists-p buffer-file-name))) |
|
(set-buffer-modified-p t)) |
|
|
|
(clearcase-commented-mkelem buffer-file-name)) |
|
|
|
(defun clearcase-mkelem-dired-files () |
|
"Make the selected files into ClearCase elements." |
|
(interactive) |
|
(clearcase-commented-mkelem-seq (dired-get-marked-files))) |
|
|
|
;;}}} |
|
|
|
;;{{{ Checkin |
|
|
|
(defun clearcase-checkin-current-buffer () |
|
"Checkin the file in the current buffer." |
|
(interactive) |
|
|
|
;; Watch out for new buffers of size 0: the corresponding file |
|
;; does not exist yet, even though buffer-modified-p is nil. |
|
;; |
|
(if (and (not (buffer-modified-p)) |
|
(zerop (buffer-size)) |
|
(not (file-exists-p buffer-file-name))) |
|
(set-buffer-modified-p t)) |
|
|
|
(clearcase-commented-checkin buffer-file-name)) |
|
|
|
(defun clearcase-checkin-dired-files () |
|
"Checkin the selected files." |
|
(interactive) |
|
(clearcase-commented-checkin-seq (dired-get-marked-files))) |
|
|
|
(defun clearcase-dired-checkin-current-dir () |
|
(interactive) |
|
(clearcase-commented-checkin (dired-current-directory))) |
|
|
|
;;}}} |
|
|
|
;;{{{ Edit checkout comment |
|
|
|
(defun clearcase-edit-checkout-comment-current-buffer () |
|
"Edit the clearcase comment for the checked-out file in the current buffer." |
|
(interactive) |
|
(clearcase-edit-checkout-comment buffer-file-name)) |
|
|
|
(defun clearcase-edit-checkout-comment-dired-file () |
|
"Checkin the selected file." |
|
(interactive) |
|
(clearcase-edit-checkout-comment (dired-get-filename))) |
|
|
|
(defun clearcase-edit-checkout-comment (file &optional comment) |
|
"Edit comment for FILE by popping up a buffer to accept one. If COMMENT |
|
is specified, save it." |
|
(if (null comment) |
|
;; If no comment supplied, go and get one... |
|
;; |
|
(clearcase-comment-start-entry (file-name-nondirectory file) |
|
"Edit the file's check-out comment." |
|
'clearcase-edit-checkout-comment |
|
(list buffer-file-name) |
|
(find-file-noselect file) |
|
(clearcase-fprop-comment file)) |
|
;; We have a comment, save it |
|
(clearcase-comment-save-comment-for-buffer comment clearcase-parent-buffer))) |
|
|
|
;;}}} |
|
|
|
;;{{{ Checkout |
|
|
|
(defun clearcase-checkout-current-buffer () |
|
"Checkout the file in the current buffer." |
|
(interactive) |
|
(clearcase-commented-checkout buffer-file-name)) |
|
|
|
(defun clearcase-checkout-dired-files () |
|
"Checkout the selected files." |
|
(interactive) |
|
(clearcase-commented-checkout-seq (dired-get-marked-files))) |
|
|
|
(defun clearcase-dired-checkout-current-dir () |
|
(interactive) |
|
(clearcase-commented-checkout (dired-current-directory))) |
|
|
|
;;}}} |
|
|
|
;;{{{ Uncheckout |
|
|
|
(defun clearcase-uncheckout-current-buffer () |
|
"Uncheckout the file in the current buffer." |
|
(interactive) |
|
(clearcase-uncheckout buffer-file-name)) |
|
|
|
(defun clearcase-uncheckout-dired-files () |
|
"Uncheckout the selected files." |
|
(interactive) |
|
(clearcase-uncheckout-seq (dired-get-marked-files))) |
|
|
|
(defun clearcase-dired-uncheckout-current-dir () |
|
(interactive) |
|
(clearcase-uncheckout (dired-current-directory))) |
|
|
|
;;}}} |
|
|
|
;;{{{ Mkbrtype |
|
|
|
(defun clearcase-mkbrtype (typename) |
|
(interactive "sBranch type name: ") |
|
(clearcase-commented-mkbrtype typename)) |
|
|
|
;;}}} |
|
|
|
;;{{{ Describe |
|
|
|
(defun clearcase-describe-current-buffer () |
|
"Give a ClearCase description of the file in the current buffer." |
|
(interactive) |
|
(clearcase-describe buffer-file-name)) |
|
|
|
(defun clearcase-describe-dired-file () |
|
"Describe the selected files." |
|
(interactive) |
|
(clearcase-describe (dired-get-filename))) |
|
|
|
;;}}} |
|
|
|
;;{{{ What-rule |
|
|
|
(defun clearcase-what-rule-current-buffer () |
|
(interactive) |
|
(clearcase-what-rule buffer-file-name)) |
|
|
|
(defun clearcase-what-rule-dired-file () |
|
(interactive) |
|
(clearcase-what-rule (dired-get-filename))) |
|
|
|
;;}}} |
|
|
|
;;{{{ List history |
|
|
|
(defun clearcase-list-history-current-buffer () |
|
"List the change history of the current buffer in a window." |
|
(interactive) |
|
(clearcase-list-history buffer-file-name)) |
|
|
|
(defun clearcase-list-history-dired-file () |
|
"List the change history of the current file." |
|
(interactive) |
|
(clearcase-list-history (dired-get-filename))) |
|
|
|
;;}}} |
|
|
|
;;{{{ Ediff |
|
|
|
(defun clearcase-ediff-pred-current-buffer () |
|
"Use Ediff to compare a version in the current buffer against its predecessor." |
|
(interactive) |
|
(clearcase-ediff-file-with-version buffer-file-name |
|
(clearcase-fprop-predecessor-version buffer-file-name))) |
|
|
|
(defun clearcase-ediff-pred-dired-file () |
|
"Use Ediff to compare the selected version against its predecessor." |
|
(interactive) |
|
(let ((truename (clearcase-fprop-truename (dired-get-filename)))) |
|
(clearcase-ediff-file-with-version truename |
|
(clearcase-fprop-predecessor-version truename)))) |
|
|
|
(defun clearcase-ediff-branch-base-current-buffer() |
|
"Use Ediff to compare a version in the current buffer |
|
against the base of its branch." |
|
(interactive) |
|
(clearcase-ediff-file-with-version buffer-file-name |
|
(clearcase-vxpath-version-of-branch-base buffer-file-name))) |
|
|
|
(defun clearcase-ediff-branch-base-dired-file() |
|
"Use Ediff to compare the selected version against the base of its branch." |
|
(interactive) |
|
(let ((truename (clearcase-fprop-truename (dired-get-filename)))) |
|
(clearcase-ediff-file-with-version truename |
|
(clearcase-vxpath-version-of-branch-base truename)))) |
|
|
|
(defun clearcase-ediff-named-version-current-buffer (version) |
|
;; nyi: if we're in history-mode, probably should just use |
|
;; (read-file-name) |
|
;; |
|
(interactive (list (clearcase-read-version-name "Version for comparison: " |
|
buffer-file-name))) |
|
(clearcase-ediff-file-with-version buffer-file-name version)) |
|
|
|
(defun clearcase-ediff-named-version-dired-file (version) |
|
;; nyi: if we're in history-mode, probably should just use |
|
;; (read-file-name) |
|
;; |
|
(interactive (list (clearcase-read-version-name "Version for comparison: " |
|
(dired-get-filename)))) |
|
(clearcase-ediff-file-with-version (clearcase-fprop-truename (dired-get-filename)) |
|
version)) |
|
|
|
(defun clearcase-ediff-file-with-version (truename other-version) |
|
(let ((other-vxpath (clearcase-vxpath-cons-vxpath (clearcase-vxpath-element-part truename) |
|
other-version))) |
|
(if (clearcase-file-is-in-mvfs-p truename) |
|
(ediff-files other-vxpath truename) |
|
(ediff-buffers (clearcase-vxpath-get-version-in-buffer other-vxpath) |
|
(find-file-noselect truename t))))) |
|
|
|
;;}}} |
|
|
|
;;{{{ GUI diff |
|
|
|
(defun clearcase-gui-diff-pred-current-buffer () |
|
"Use GUI to compare a version in the current buffer against its predecessor." |
|
(interactive) |
|
(clearcase-gui-diff-file-with-version buffer-file-name |
|
(clearcase-fprop-predecessor-version buffer-file-name))) |
|
|
|
(defun clearcase-gui-diff-pred-dired-file () |
|
"Use GUI to compare the selected version against its predecessor." |
|
(interactive) |
|
(let ((truename (clearcase-fprop-truename (dired-get-filename)))) |
|
(clearcase-gui-diff-file-with-version truename |
|
(clearcase-fprop-predecessor-version truename)))) |
|
|
|
(defun clearcase-gui-diff-branch-base-current-buffer() |
|
"Use GUI to compare a version in the current buffer |
|
against the base of its branch." |
|
(interactive) |
|
(clearcase-gui-diff-file-with-version buffer-file-name |
|
(clearcase-vxpath-version-of-branch-base buffer-file-name))) |
|
|
|
(defun clearcase-gui-diff-branch-base-dired-file() |
|
"Use GUI to compare the selected version against the base of its branch." |
|
(interactive) |
|
(let ((truename (clearcase-fprop-truename (dired-get-filename)))) |
|
(clearcase-gui-diff-file-with-version truename |
|
(clearcase-vxpath-version-of-branch-base truename)))) |
|
|
|
(defun clearcase-gui-diff-named-version-current-buffer (version) |
|
;; nyi: if we're in history-mode, probably should just use |
|
;; (read-file-name) |
|
;; |
|
(interactive (list (clearcase-read-version-name "Version for comparison: " |
|
buffer-file-name))) |
|
(clearcase-gui-diff-file-with-version buffer-file-name version)) |
|
|
|
(defun clearcase-gui-diff-named-version-dired-file (version) |
|
;; nyi: if we're in history-mode, probably should just use |
|
;; (read-file-name) |
|
;; |
|
(interactive (list (clearcase-read-version-name "Version for comparison: " |
|
(dired-get-filename)))) |
|
(clearcase-gui-diff-file-with-version (clearcase-fprop-truename (dired-get-filename)) |
|
version)) |
|
|
|
(defun clearcase-gui-diff-file-with-version (truename other-version) |
|
(let* ((other-vxpath (clearcase-vxpath-cons-vxpath (clearcase-vxpath-element-part truename) |
|
other-version)) |
|
(other-file (if (clearcase-file-is-in-mvfs-p truename) |
|
other-vxpath |
|
(clearcase-vxpath-get-version-in-temp-file other-vxpath))) |
|
(gui-name (if clearcase-on-mswindows |
|
"cleardiffmrg" |
|
"xcleardiff"))) |
|
(start-process "Diff" |
|
nil |
|
gui-name |
|
(clearcase-path-native other-file) |
|
(clearcase-path-native truename)))) |
|
|
|
;;}}} |
|
|
|
;;{{{ Diff |
|
|
|
(defun clearcase-diff-pred-current-buffer () |
|
"Use Diff to compare a version in the current buffer against its predecessor." |
|
(interactive) |
|
(clearcase-diff-file-with-version buffer-file-name |
|
(clearcase-fprop-predecessor-version buffer-file-name))) |
|
|
|
(defun clearcase-diff-pred-dired-file () |
|
"Use Diff to compare the selected version against its predecessor." |
|
(interactive) |
|
(let ((truename (clearcase-fprop-truename (dired-get-filename)))) |
|
(clearcase-diff-file-with-version truename |
|
(clearcase-fprop-predecessor-version truename)))) |
|
|
|
(defun clearcase-diff-branch-base-current-buffer() |
|
"Use Diff to compare a version in the current buffer |
|
against the base of its branch." |
|
(interactive) |
|
(clearcase-diff-file-with-version buffer-file-name |
|
(clearcase-vxpath-version-of-branch-base buffer-file-name))) |
|
|
|
(defun clearcase-diff-branch-base-dired-file() |
|
"Use Diff to compare the selected version against the base of its branch." |
|
(interactive) |
|
(let ((truename (clearcase-fprop-truename (dired-get-filename)))) |
|
(clearcase-diff-file-with-version truename |
|
(clearcase-vxpath-version-of-branch-base truename)))) |
|
|
|
(defun clearcase-diff-named-version-current-buffer (version) |
|
;; nyi: if we're in history-mode, probably should just use |
|
;; (read-file-name) |
|
;; |
|
(interactive (list (clearcase-read-version-name "Version for comparison: " |
|
buffer-file-name))) |
|
(clearcase-diff-file-with-version buffer-file-name version)) |
|
|
|
(defun clearcase-diff-named-version-dired-file (version) |
|
;; nyi: if we're in history-mode, probably should just use |
|
;; (read-file-name) |
|
;; |
|
(interactive (list (clearcase-read-version-name "Version for comparison: " |
|
(dired-get-filename)))) |
|
(clearcase-diff-file-with-version (clearcase-fprop-truename (dired-get-filename)) |
|
version)) |
|
|
|
(defun clearcase-diff-file-with-version (truename other-version) |
|
(let ((other-vxpath (clearcase-vxpath-cons-vxpath (clearcase-vxpath-element-part truename) |
|
other-version))) |
|
(if (clearcase-file-is-in-mvfs-p truename) |
|
(clearcase-diff-files other-vxpath truename) |
|
(clearcase-diff-files (clearcase-vxpath-get-version-in-temp-file other-vxpath) |
|
truename)))) |
|
|
|
;;}}} |
|
|
|
;;{{{ Browse vtree |
|
|
|
(defun clearcase-version-other-window (version) |
|
(interactive |
|
(list |
|
(clearcase-read-version-name (format "Version of %s to visit: " |
|
(file-name-nondirectory buffer-file-name)) |
|
buffer-file-name))) |
|
(find-file-other-window (clearcase-vxpath-cons-vxpath |
|
(clearcase-vxpath-element-part buffer-file-name) |
|
version))) |
|
|
|
(defun clearcase-browse-vtree-current-buffer () |
|
(interactive) |
|
(clearcase-browse-vtree buffer-file-name)) |
|
|
|
(defun clearcase-browse-vtree-dired-file () |
|
(interactive) |
|
(clearcase-browse-vtree (dired-get-filename))) |
|
|
|
;;}}} |
|
|
|
;;{{{ GUI vtree |
|
|
|
(defun clearcase-gui-vtree-browser-current-buffer () |
|
(interactive) |
|
(clearcase-gui-vtree-browser buffer-file-name)) |
|
|
|
(defun clearcase-gui-vtree-browser-dired-file () |
|
(interactive) |
|
(clearcase-gui-vtree-browser (dired-get-filename))) |
|
|
|
(defun clearcase-gui-vtree-browser (file) |
|
(let ((gui-name (if clearcase-on-mswindows |
|
"clearvtree" |
|
"xlsvtree"))) |
|
(start-process-shell-command "Vtree_browser" |
|
nil |
|
gui-name |
|
(clearcase-path-native file)))) |
|
|
|
;;}}} |
|
|
|
;;{{{ Other GUIs |
|
|
|
(defun clearcase-gui-clearexplorer () |
|
(interactive) |
|
(start-process-shell-command "ClearExplorer" |
|
nil |
|
"clearexplorer" |
|
".")) |
|
|
|
(defun clearcase-gui-rebase () |
|
(interactive) |
|
(start-process-shell-command "Rebase" |
|
nil |
|
"clearmrgman" |
|
(if clearcase-on-mswindows |
|
"/rebase" |
|
"-rebase"))) |
|
|
|
(defun clearcase-gui-deliver () |
|
(interactive) |
|
(start-process-shell-command "Deliver" |
|
nil |
|
"clearmrgman" |
|
(if clearcase-on-mswindows |
|
"/deliver" |
|
"-deliver"))) |
|
|
|
(defun clearcase-gui-merge-manager () |
|
(interactive) |
|
(start-process-shell-command "Merge_manager" |
|
nil |
|
"clearmrgman")) |
|
|
|
(defun clearcase-gui-project-explorer () |
|
(interactive) |
|
(start-process-shell-command "Project_explorer" |
|
nil |
|
"clearprojexp")) |
|
|
|
(defun clearcase-gui-snapshot-view-updater () |
|
(interactive) |
|
(start-process-shell-command "View_updater" |
|
nil |
|
"clearviewupdate")) |
|
|
|
;;}}} |
|
|
|
;;{{{ Update snapshot |
|
|
|
;; In a file buffer: |
|
;; - update current-file |
|
;; - update directory |
|
;; In dired: |
|
;; - update dir |
|
;; - update marked files |
|
;; - update file |
|
|
|
;; We allow several simultaneous updates, but only one per view. |
|
|
|
(defun clearcase-update-view () |
|
(interactive) |
|
(clearcase-update (clearcase-fprop-viewtag default-directory))) |
|
|
|
(defun clearcase-update-default-directory () |
|
(interactive) |
|
(clearcase-update (clearcase-fprop-viewtag default-directory) |
|
default-directory)) |
|
|
|
(defun clearcase-update-current-buffer () |
|
(interactive) |
|
(clearcase-update (clearcase-fprop-viewtag default-directory) |
|
buffer-file-name)) |
|
|
|
(defun clearcase-update-dired-files () |
|
(interactive) |
|
(apply (function clearcase-update) |
|
(cons (clearcase-fprop-viewtag default-directory) |
|
(dired-get-marked-files)))) |
|
|
|
|
|
;;}}} |
|
|
|
;;}}} |
|
|
|
;;{{{ Functions |
|
|
|
;;{{{ Basic ClearCase operations |
|
|
|
;;{{{ Update snapshot view |
|
|
|
;;{{{ Asynchronous post-processing of update |
|
|
|
(defvar clearcase-post-update-timer nil) |
|
(defvar clearcase-post-update-work-queue nil) |
|
|
|
(defun clearcase-post-update-schedule-work (buffer) |
|
(clearcase-trace "entering clearcase-post-update-schedule-work") |
|
;; Add to the work queue. |
|
;; |
|
(setq clearcase-post-update-work-queue (cons buffer |
|
clearcase-post-update-work-queue)) |
|
;; Create the timer if necessary. |
|
;; |
|
(if (null clearcase-post-update-timer) |
|
(if clearcase-xemacs-p |
|
;; Xemacs |
|
;; |
|
(setq clearcase-post-update-timer |
|
(run-with-idle-timer 2 t 'clearcase-post-update-timer-function)) |
|
;; FSF Emacs |
|
;; |
|
(progn |
|
(setq clearcase-post-update-timer (timer-create)) |
|
(timer-set-function clearcase-post-update-timer 'clearcase-post-update-timer-function) |
|
(timer-set-idle-time clearcase-post-update-timer 2) |
|
(timer-activate-when-idle clearcase-post-update-timer))) |
|
(clearcase-trace "clearcase-post-update-schedule-work: post-update timer found to be non-null"))) |
|
|
|
|
|
(defun clearcase-post-update-timer-function () |
|
(clearcase-trace "Entering clearcase-post-update-timer-function") |
|
;; For (each update-process buffer in the work queue) |
|
;; if (its process has successfully terminated) |
|
;; do the post-processing for this update |
|
;; remove it from the work queue |
|
;; |
|
(clearcase-trace (format "Queue before: %s" clearcase-post-update-work-queue)) |
|
(setq clearcase-post-update-work-queue |
|
|
|
(clearcase-utl-list-filter |
|
(function clearcase-post-update-check-process-buffer) |
|
clearcase-post-update-work-queue)) |
|
|
|
(clearcase-trace (format "Queue after: %s" clearcase-post-update-work-queue)) |
|
;; If the work queue is now empty cancel the timer. |
|
;; |
|
(if (null clearcase-post-update-work-queue) |
|
(progn |
|
(cancel-timer clearcase-post-update-timer) |
|
(setq clearcase-post-update-timer nil)))) |
|
|
|
(defun clearcase-post-update-check-process-buffer (buffer) |
|
(clearcase-trace "Entering clearcase-post-update-check-process-buffer") |
|
|
|
;; return t for those buffers that should remain in the work queue |
|
|
|
;; if it has terminated successfully |
|
;; go sync buffers on the files that were updated |
|
|
|
;; We want to field errors here and when they occurm return nil to avoid a |
|
;; loop |
|
;; |
|
;;(condition-case nil |
|
|
|
;; protected form |
|
(let ((proc (get-buffer-process buffer))) |
|
(if proc |
|
;; Process still exists so keep this on the work queue. |
|
;; |
|
(progn |
|
(clearcase-trace "Update process still exists") |
|
t) |
|
|
|
;; Process no longer there, cleaned up by comint code. |
|
;; |
|
|
|
;; Sync any buffers that need it. |
|
;; |
|
(clearcase-trace "Update process finished") |
|
(clearcase-sync-after-scopes-updated (with-current-buffer buffer |
|
;; Evaluate buffer-local variable. |
|
;; |
|
clearcase-update-buffer-scopes)) |
|
|
|
;; Remove from work queue |
|
;; |
|
nil)) |
|
|
|
;; Error occurred, make sure we return nil to remove the buffer from the |
|
;; work queue, or a loop could develop. |
|
;; |
|
;;(error nil) |
|
) |
|
|
|
(defun clearcase-sync-after-scopes-updated (scopes) |
|
(clearcase-trace "Entering clearcase-sync-after-scopes-updated") |
|
|
|
;; nyi: reduce scopes to minimal set of disjoint scopes |
|
|
|
;; Use dynamic binding here since we don't have lexical binding. |
|
;; |
|
(let ((clearcase-dynbound-updated-scopes scopes)) |
|
|
|
;; For all buffers... |
|
;; |
|
(mapcar |
|
(function |
|
(lambda (buffer) |
|
(let ((visited-file (buffer-file-name buffer))) |
|
(if visited-file |
|
(if (clearcase-path-file-in-any-scopes visited-file |
|
clearcase-dynbound-updated-scopes) |
|
;; This buffer visits a file within an updated scope. |
|
;; Sync it from disk if it needs it. |
|
;; |
|
(clearcase-sync-from-disk-if-needed visited-file)) |
|
|
|
;; Buffer is not visiting a file. If it is a dired-mode buffer |
|
;; under one of the scopes, revert it. |
|
;; |
|
(with-current-buffer buffer |
|
(if (eq 'dired-mode major-mode) |
|
(if (clearcase-path-file-in-any-scopes default-directory |
|
clearcase-dynbound-updated-scopes) |
|
(dired-revert nil t)))))))) |
|
(buffer-list)))) |
|
|
|
;;}}} |
|
|
|
;; Silence compiler complaints about free variable. |
|
;; |
|
(defvar clearcase-update-buffer-viewtag nil) |
|
|
|
(defun clearcase-update (viewtag &rest files) |
|
"Run a cleartool+update process in VIEWTAG |
|
if there isn't one already running in that view. |
|
Other arguments FILES indicate files to update" |
|
|
|
;; Check that there is no update process running in that view. |
|
;; |
|
( |