(defconst rcsid-pcl-cvs-hooks "@(#)$Name$:$Id$")
;; Copyright (C) 1998-1999 Stefan Monnier <firstname.lastname@example.org>
;; 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 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Code (mostly advice) to hook pcl-cvs services into other packages
(defcustom cvs-dired-action 'cvs-examine
"The action to be performed when opening a CVS directory.
Sensible values are 'cvs-examine and 'cvs-status."
:type '(choice (const cvs-examine) (const cvs-status)))
(defcustom cvs-dired-use-hook '(4)
"Whether or not opening a CVS directory should run pcl-cvs.
NIL means never do it.
ALWAYS means to always do it unless a prefix argument is given to the
command that prompted the opening of the directory.
Anything else means to do it only if the prefix arg is equal to this value."
:type '(choice (const :tag "Never" nil)
(const :tag "Always" always)
(const :tag "Prefix" (4))))
;; hook into VC
(defadvice vc-backend-diff (after diff-mode-vc activate)
(defadvice vc-do-command (after pcl-cvs-vc activate)
(let ((command (ad-get-arg 2))
(buffer (get-buffer (or (ad-get-arg 0) "*vc*"))))
;; make sure we are in the case VC-cvs + pcl-cvs
(when (and (fboundp 'cvs-mode) (string= command "cvs"))
(let ((cvscmd (ad-get-arg 5)))
;; don't parse output we don't understand.
;; I could probably use "string= buffer "*vc*" instead to detect
;; when the output is supposed to be seen by the user. But VC
;; uses *vc* for `cvs log' and `cvs tag' which the parser doesn't
;; (yet) understand.
;;(when (string= (buffer-name buffer) "*vc*")
(unless (member cvscmd '("log" "diff" "-v" "tag"))
(let ((dir (get-buffer-var buffer 'default-directory)))
(dolist (cvs-buf (buffer-list))
;; look for a corresponding pcl-cvs buffer
(when (and (eq major-mode 'cvs-mode)
(string-prefix-p default-directory dir))
(let ((args (ad-get-args 0))
(subdir (substring dir (length default-directory))))
(message "args: %s" args)
(set (make-local-variable 'cvs-buffer) cvs-buf)
;; VC never (?) does `cvs -n update' so dcd=nil
;; should probably always be the right choice.
(cvs-parse-process nil subdir)))))))))))
;; hook into uniquify
(defadvice uniquify-buffer-file-name (after pcl-cvs-uniquify activate)
(set-buffer (ad-get-arg 0))
(when (eq major-mode 'cvs-mode)
(setq ad-return-value list-buffers-directory)))))
;; hook into dired
(defadvice dired-noselect (around pcl-cvs-dired activate)
(let* ((arg (ad-get-arg 0))
(dir (and (stringp arg) (directory-file-name arg))))
(if (and dir (string= "CVS" (file-name-nondirectory dir))
(file-readable-p (expand-file-name "Entries" dir))
(if (eq cvs-dired-use-hook 'always)
(equal current-prefix-arg cvs-dired-use-hook)))
(funcall cvs-dired-action (file-name-directory dir) t t)))
;; hook into the main menubar
;; provide the package
;; diff-mode.el ends here