*** empty log message ***
[emacs.git] / lisp / pcmpl-cvs.el
blob854479d43059a49d37c9be1fb82717efd0dfe8b8
1 ;;; pcmpl-cvs --- functions for dealing with cvs completions
3 ;; Copyright (C) 1999, 2000 Free Software Foundation
5 ;; This file is part of GNU Emacs.
7 ;; GNU Emacs is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation; either version 2, or (at your option)
10 ;; any later version.
12 ;; GNU Emacs is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with GNU Emacs; see the file COPYING. If not, write to the
19 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 ;; Boston, MA 02111-1307, USA.
22 ;;; Commentary:
24 ;; These functions provide completion rules for the `cvs' tool.
26 ;;; Code:
28 (provide 'pcmpl-cvs)
30 (require 'pcomplete)
31 (require 'executable)
33 (defgroup pcmpl-cvs nil
34 "Functions for dealing with CVS completions"
35 :group 'pcomplete)
37 ;; User Variables:
39 (defcustom pcmpl-cvs-binary (or (executable-find "cvs") "cvs")
40 "*The full path of the 'cvs' binary."
41 :type 'file
42 :group 'pcmpl-cvs)
44 ;; Functions:
46 ;;;###autoload
47 (defun pcomplete/cvs ()
48 "Completion rules for the `cvs' command."
49 (let ((pcomplete-help "(cvs)Invoking CVS"))
50 (pcomplete-opt "HQqrwlntvfab/T/e*d/z?s")
51 (pcomplete-here* (pcmpl-cvs-commands))
52 (cond ((pcomplete-test "add")
53 (setq pcomplete-help "(cvs)Adding files")
54 (pcomplete-opt "k?m?")
55 (while (pcomplete-here (pcmpl-cvs-entries '(??)))))
56 ((pcomplete-test "remove")
57 (setq pcomplete-help "(cvs)Removing files")
58 (pcomplete-opt "flR")
59 (while (pcomplete-here (pcmpl-cvs-entries '(?U)))))
60 ((pcomplete-test "init")
61 (setq pcomplete-help "(cvs)Creating a repository"))
62 ((pcomplete-test '("login" "logout"))
63 (setq pcomplete-help "(cvs)Password authentication client"))
64 ((pcomplete-test "import")
65 (setq pcomplete-help "(cvs)import")
66 (pcomplete-opt "dk?I(pcmpl-cvs-entries '(??))b?m?W?"))
67 ((pcomplete-test "checkout")
68 (setq pcomplete-help "(cvs)checkout")
69 (pcomplete-opt "ANPRcflnpsr?D?d/k?j?")
70 (pcomplete-here (pcmpl-cvs-modules)))
71 ((pcomplete-test "rtag")
72 (setq pcomplete-help "(cvs)Creating a branch")
73 (pcomplete-opt "aflRndbr?DF")
74 (pcomplete-here (pcmpl-cvs-modules)))
75 ((pcomplete-test "release")
76 (setq pcomplete-help "(cvs)release")
77 (pcomplete-opt "d")
78 (while (pcomplete-here (pcomplete-dirs))))
79 ((pcomplete-test "export")
80 (setq pcomplete-help "(cvs)export")
81 (pcomplete-opt "NflRnr?D?d/k?")
82 (pcomplete-here (pcmpl-cvs-modules)))
83 ((pcomplete-test "commit")
84 (setq pcomplete-help "(cvs)commit files")
85 (pcomplete-opt "nRlfF.m?r(pcmpl-cvs-tags '(?M ?R ?A))")
86 (while (pcomplete-here (pcmpl-cvs-entries '(?M ?R ?A)))))
87 ((pcomplete-test "diff")
88 (setq pcomplete-help "(cvs)Viewing differences")
89 (let ((opt-index pcomplete-index)
90 saw-backdate)
91 (pcomplete-opt "lRD?Nr(pcmpl-cvs-tags)")
92 (while (< opt-index pcomplete-index)
93 (if (pcomplete-match "^-[Dr]" (- pcomplete-index opt-index))
94 (setq saw-backdate t opt-index pcomplete-index)
95 (setq opt-index (1+ opt-index))))
96 (while (pcomplete-here
97 (pcmpl-cvs-entries (unless saw-backdate '(?M)))))))
98 ((pcomplete-test "unedit")
99 (setq pcomplete-help "(cvs)Editing files")
100 (pcomplete-opt "lR")
101 (while (pcomplete-here (pcmpl-cvs-entries '(?M ?R ?A)))))
102 ((pcomplete-test "update")
103 (setq pcomplete-help "(cvs)update")
104 (pcomplete-opt
105 (concat "APdflRpk?r(pcmpl-cvs-tags '(?U ?P))D?"
106 "j(pcmpl-cvs-tags '(?U ?P))"
107 "I(pcmpl-cvs-entries '(??))W?"))
108 (while (pcomplete-here (pcmpl-cvs-entries '(?U ?P)))))
110 (while (pcomplete-here (pcmpl-cvs-entries)))))))
112 (defun pcmpl-cvs-commands ()
113 "Return a list of available CVS commands."
114 (with-temp-buffer
115 (call-process pcmpl-cvs-binary nil t nil "--help-commands")
116 (goto-char (point-min))
117 (let (cmds)
118 (while (re-search-forward "^\\s-+\\([a-z]+\\)" nil t)
119 (setq cmds (cons (match-string 1) cmds)))
120 (pcomplete-uniqify-list cmds))))
122 (defun pcmpl-cvs-modules ()
123 "Return a list of available modules under CVS."
124 (with-temp-buffer
125 (call-process pcmpl-cvs-binary nil t nil "checkout" "-c")
126 (goto-char (point-min))
127 (let (entries)
128 (while (re-search-forward "\\(\\S-+\\)$" nil t)
129 (setq entries (cons (match-string 1) entries)))
130 (pcomplete-uniqify-list entries))))
132 (defun pcmpl-cvs-tags (&optional opers)
133 "Return all the tags which could apply to the files related to OPERS."
134 (let ((entries (pcmpl-cvs-entries opers))
135 tags)
136 (with-temp-buffer
137 (apply 'call-process pcmpl-cvs-binary nil t nil
138 "status" "-v" entries)
139 (goto-char (point-min))
140 (while (re-search-forward "Existing Tags:" nil t)
141 (forward-line)
142 (while (not (looking-at "^$"))
143 (unless (looking-at "^\\s-+\\(\\S-+\\)\\s-+")
144 (error "Error in output from `cvs status -v'"))
145 (setq tags (cons (match-string 1) tags))
146 (forward-line))))
147 (pcomplete-uniqify-list tags)))
149 (defun pcmpl-cvs-entries (&optional opers)
150 "Return the Entries for the current directory.
151 If OPERS is a list of characters, return entries for which that
152 operation character applies, as displayed by 'cvs -n update'."
153 (let* ((arg (pcomplete-arg))
154 (dir (file-name-as-directory
155 (or (file-name-directory arg) "")))
156 (nondir (or (file-name-nondirectory arg) ""))
157 entries)
158 (if opers
159 (with-temp-buffer
160 (and dir (cd dir))
161 (call-process pcmpl-cvs-binary nil t nil
162 "-q" "-n" "-f" "update"); "-l")
163 (goto-char (point-min))
164 (while (re-search-forward "^\\(.\\) \\(.+\\)$" nil t)
165 (if (memq (string-to-char (match-string 1)) opers)
166 (setq entries (cons (match-string 2) entries)))))
167 (with-temp-buffer
168 (insert-file-contents (concat dir "CVS/Entries"))
169 (goto-char (point-min))
170 (while (not (eobp))
171 (let* ((line (buffer-substring (line-beginning-position)
172 (line-end-position)))
173 (fields (split-string line "/"))
174 text)
175 (if (eq (aref line 0) ?/)
176 (setq fields (cons "" fields)))
177 (setq text (nth 1 fields))
178 (when text
179 (if (string= (nth 0 fields) "D")
180 (setq text (file-name-as-directory text)))
181 (setq entries (cons text entries))))
182 (forward-line))))
183 (setq pcomplete-stub nondir)
184 (pcomplete-uniqify-list entries)))
186 ;;; pcmpl-cvs.el ends here