pcl-cvs / pcl-cvs-hooks.el

;;; pcl-cvs-hooks.el

(defconst rcsid-pcl-cvs-hooks "$Id")

;; Copyright (C) 1998  Stefan Monnier <>
;; 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
;; 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

(require 'advice)
(require 'cl)


(defcustom cvs-dired-action 'cvs-examine
  "The action to be performed when opening a CVS directory.
Sensible values are 'cvs-examine and 'cvs-status."
  :group 'pcl-cvs
  :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."
  :group 'pcl-cvs
  :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)
    (set-buffer "*vc-diff*")

(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))
		(set-buffer cvs-buf)
		;; 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-buffer buffer)
		    (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)
  (or ad-return-value
	(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)
		 (not current-prefix-arg)
	       (equal current-prefix-arg cvs-dired-use-hook)))
	  (setq ad-return-value
		(funcall cvs-dired-action (file-name-directory dir) t t)))

;; hook into the main menubar

;; provide the package

(provide 'pcl-cvs-hooks)

;; diff-mode.el ends here