;;; pcvs.el --- a front-end to CVS;; Copyright (C) 1991,92,93,94,95,95,97,98,99,2000,02,2003;; Free Software Foundation, Inc.;; Author: (The PCL-CVS Trust) pcl-cvs@cyclic.com;; (Per Cederqvist) ceder@lysator.liu.se;; (Greg A. Woods) woods@weird.com;; (Jim Blandy) jimb@cyclic.com;; (Karl Fogel) kfogel@floss.red-bean.com;; (Jim Kingdon) kingdon@cyclic.com;; (Stefan Monnier) monnier@cs.yale.edu;; (Greg Klanderman) greg@alphatech.com;; (Jari Aalto+mail.emacs) jari.aalto@poboxes.com;; Maintainer: (Stefan Monnier) monnier+lists/cvs/pcl@flint.cs.yale.edu;; Keywords: CVS, version control, release management;; This file is part of GNU Emacs.;; GNU Emacs 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.;; GNU Emacs 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.;;; Commentary:;; PCL-CVS is a front-end to the CVS version control system. For people;; familiar with VC, it is somewhat like VC-dired: it presents the status of;; all the files in your working area and allows you to commit/update several;; of them at a time. Compared to VC-dired, it is considerably better and;; faster (but only for CVS).;; PCL-CVS was originally written by Per Cederqvist many years ago. This;; version derives from the XEmacs-21 version, itself based on the 2.0b2;; version (last release from Per). It is a thorough rework.;; Contrary to what you'd expect, PCL-CVS is not a replacement for VC but only;; for VC-dired. As such, I've tried to make PCL-CVS and VC interoperate;; seamlessly (I also use VC).;; To use PCL-CVS just use `M-x cvs-examine RET <dir> RET'.;; There is a TeXinfo manual, which can be helpful to get started.;;; Bugs:;; - Extracting an old version seems not to recognize encoding correctly.;; That's probably because it's done via a process rather than a file.;;; Todo:;; ******** FIX THE DOCUMENTATION *********;;;; - rework the displaying of error messages.;; - allow to flush messages only;; - allow to protect files like ChangeLog from flushing;; - automatically cvs-mode-insert files from find-file-hook;; (and don't flush them as long as they are visited);; - query the user for cvs-get-marked (for some cmds or if nothing's selected);; - don't return the first (resp last) FI if the cursor is before;; (resp after) it.;; - allow cvs-confirm-removals to force always confirmation.;; - cvs-checkout should ask for a revision (with completion).;; - removal confirmation should allow specifying another file name.;;;; - hide fileinfos without getting rid of them (will require ewok work).;; - add toolbar entries;; - marking;; marking directories should jump to just after the dir.;; allow (un)marking directories at a time with the mouse.;; allow cvs-cmd-do to either clear the marks or not.;; add a "marks active" notion, like transient-mark-mode does.;; - liveness indicator;; - indicate in docstring if the cmd understands the `b' prefix(es).;; - call smerge-mode when opening CONFLICT files.;; - have vc-checkin delegate to cvs-mode-commit when applicable;; - higher-level CVS operations;; cvs-mode-rename;; cvs-mode-branch;; - module-level commands;; add support for parsing 'modules' file ("cvs co -c");; cvs-mode-rcs2log;; cvs-rdiff;; cvs-release;; cvs-import;; C-u M-x cvs-checkout should ask for a cvsroot;; cvs-mode-handle-new-vendor-version;; - checks out module, or alternately does update join;; - does "cvs -n tag LAST_VENDOR" to find old files into *cvs*;; cvs-export;; (with completion on tag names and hooks to help generate full releases);; - display stickiness information. And current CVS/Tag as well.;; - write 'cvs-mode-admin' to do arbitrary 'cvs admin' commands;; Most interesting would be version removal and log message replacement.;; The last one would be neat when called from log-view-mode.;; - cvs-mode-incorporate;; It would merge in the status from one *cvs* buffer into another.;; This would be used to populate such a buffer that had been created with;; a `cvs {update,status,checkout} -l'.;; - cvs-mode-(i)diff-other-{file,buffer,cvs-buffer};; - offer the choice to kill the process when the user kills the cvs buffer.;; right now, it's killed without further ado.;; - make `cvs-mode-ignore' allow manually entering a pattern.;; to which dir should it apply ?;; - cvs-mode-ignore should try to remove duplicate entries.;; - maybe poll/check CVS/Entries files to react to external `cvs' commands ?;; - some kind of `cvs annotate' support ?;; but vc-annotate can be used instead.;; - proper `g' that passes safe args and uses either cvs-status or cvs-examine;; maybe also use cvs-update depending on I-don't-know-what.;; - add message-levels so that we can hide some levels of messages;;; Code:(eval-when-compile(require'cl))(require'ewoc);Ewoc was once cookie(require'pcvs-defs)(require'pcvs-util)(require'pcvs-parse)(require'pcvs-info);;;;;;;; global vars;;;;(defvarcvs-cookies);;nil;;"Handle for the cookie structure that is displayed in the *cvs* buffer.");;(make-variable-buffer-local 'cvs-cookies);;;;;;;; Dynamically scoped variables;;;;(defvarcvs-from-vcnil"Bound to t inside VC advice.");;;;;;;; flags variables;;;;(defuncvs-defaults(&restdefs)(let((defs(cvs-firstdefscvs-shared-start)))(appenddefs(make-list(-cvs-shared-start(lengthdefs))(cardefs))cvs-shared-flags)));; For cvs flags, we need to add "-f" to override the cvsrc settings;; we also want to evict the annoying -q and -Q options that hide useful;; information from pcl-cvs.(cvs-flags-definecvs-cvs-flags'(("-f")))(cvs-flags-definecvs-checkout-flags(cvs-defaults'("-P")))(cvs-flags-definecvs-status-flags(cvs-defaults'("-v")nil))(cvs-flags-definecvs-log-flags(cvs-defaultsnil))(cvs-flags-definecvs-diff-flags(cvs-defaults'("-u""-N")'("-c""-N")'("-u""-b")))(cvs-flags-definecvs-tag-flags(cvs-defaultsnil))(cvs-flags-definecvs-add-flags(cvs-defaultsnil))(cvs-flags-definecvs-commit-flags(cvs-defaultsnil))(cvs-flags-definecvs-remove-flags(cvs-defaultsnil));;(cvs-flags-define cvs-undo-flags (cvs-defaults nil))(cvs-flags-definecvs-update-flags(cvs-defaults'("-d""-P")))(defuncvs-reread-cvsrc()"Reset the default arguments to those in the `cvs-cvsrc-file'."(interactive)(condition-casenil(with-temp-buffer(insert-file-contentscvs-cvsrc-file);; fetch the values(dolist(cmd'("cvs""checkout""status""log""diff""tag""add""commit""remove""update"))(goto-char(point-min))(when(re-search-forward(concat"^"cmd"\\(\\s-+\\(.*\\)\\)?$")nilt)(let*((sym(intern(concat"cvs-"cmd"-flags")))(val(cvs-string->strings(or(match-string2)""))))(cvs-flags-setsym0val))));; ensure that cvs doesn't have -q or -Q(cvs-flags-set'cvs-cvs-flags0(cons"-f"(cdr(cvs-partition(lambda(x)(memberx'("-q""-Q""-f")))(cvs-flags-query'cvs-cvs-flagsnil'noquery))))))(file-errornil)));; initialize to cvsrc's default values(cvs-reread-cvsrc);;;;;;;; Mouse bindings and mode motion;;;;(defvarcvs-minor-current-files)(defuncvs-menu(e)"Popup the CVS menu."(interactive"e")(let((cvs-minor-current-files(list(ewoc-data(ewoc-locatecvs-cookies(posn-point(event-ende)))))))(popup-menucvs-menue)))(defvarcvs-mode-line-processnil"Mode-line control for displaying info on cvs process status.");;;;;;;; Query-Type-Descriptor for Tags;;;;(autoload'cvs-status-get-tags"cvs-status")(defuncvs-tags-list()"Return a list of acceptable tags, ready for completions."(assert(cvs-buffer-p))(let((marked(cvs-get-marked)))(list*'("BASE")'("HEAD")(whenmarked(with-temp-buffer(call-processcvs-programnil;no inputt;output to current-buffernil;don't update display while running"status""-v"(cvs-fileinfo->full-path(carmarked)))(goto-char(point-min))(let((tags(cvs-status-get-tags)))(when(listptags)tags)))))))(defvarcvs-tag-historynil)(defconstcvs-qtypedesc-tag(cvs-qtypedesc-create'identity'identity'cvs-tags-list'cvs-tag-history));;;;(defuncvs-mode!(&optional-cvs-mode!-fun)"Switch to the *cvs* buffer.If -CVS-MODE!-FUN is provided, it is executed *cvs* being the current buffer and with its window selected. Else, the *cvs* buffer is simply selected.-CVS-MODE!-FUN is called interactively if applicable and else with no argument."(let*((-cvs-mode!-buf(current-buffer))(cvsbuf(cond((cvs-buffer-p)(current-buffer))((andcvs-buffer(cvs-buffer-pcvs-buffer))cvs-buffer)(t(error"can't find the *cvs* buffer"))))(-cvs-mode!-wrappercvs-minor-wrap-function)(-cvs-mode!-cont(lambda()(save-current-buffer(if(commandp-cvs-mode!-fun)(call-interactively-cvs-mode!-fun)(funcall-cvs-mode!-fun))))))(if(not-cvs-mode!-fun)(set-buffercvsbuf)(let((cvs-mode!-buf(current-buffer))(cvs-mode!-owin(selected-window))(cvs-mode!-nwin(get-buffer-windowcvsbuf'visible)))(unwind-protect(progn(set-buffercvsbuf)(whencvs-mode!-nwin(select-windowcvs-mode!-nwin))(if-cvs-mode!-wrapper(funcall-cvs-mode!-wrapper-cvs-mode!-buf-cvs-mode!-cont)(funcall-cvs-mode!-cont)))(set-buffercvs-mode!-buf)(when(andcvs-mode!-nwin(eqcvs-mode!-nwin(selected-window)));; the selected window has not been changed by FUN(select-windowcvs-mode!-owin)))))));;;;;;;; Prefixes;;;;(defvarcvs-branches(listcvs-vendor-branch"HEAD""HEAD"))(cvs-prefix-definecvs-branch-prefix"Current selected branch.""version"(conscvs-vendor-branchcvs-branches)cvs-qtypedesc-tag)(defuncvs-set-branch-prefix(arg)"Set the branch prefix to take action at the next command.See `cvs-prefix-set' for a further the description of the behavior.\\[universal-argument] 1 selects the vendor branchand \\[universal-argument] 2 selects the HEAD."(interactive"P")(cvs-mode!)(cvs-prefix-set'cvs-branch-prefixarg))(defuncvs-add-branch-prefix(flags&optionalarg)"Add branch selection argument if the branch prefix was set.The argument is added (or not) to the list of FLAGS and is constructedby appending the branch to ARG which defaults to \"-r\"."(let((branch(cvs-prefix-get'cvs-branch-prefix)));; deactivate the secondary prefix, even if not used.(cvs-prefix-get'cvs-secondary-branch-prefix)(ifbranch(cons(concat(orarg"-r")branch)flags)flags)))(cvs-prefix-definecvs-secondary-branch-prefix"Current secondary selected branch.""version"(conscvs-vendor-branchcvs-branches)cvs-qtypedesc-tag)(defuncvs-set-secondary-branch-prefix(arg)"Set the branch prefix to take action at the next command.See `cvs-prefix-set' for a further the description of the behavior.\\[universal-argument] 1 selects the vendor branchand \\[universal-argument] 2 selects the HEAD."(interactive"P")(cvs-mode!)(cvs-prefix-set'cvs-secondary-branch-prefixarg))(defuncvs-add-secondary-branch-prefix(flags&optionalarg)"Add branch selection argument if the secondary branch prefix was set.The argument is added (or not) to the list of FLAGS and is constructedby appending the branch to ARG which defaults to \"-r\".Since the `cvs-secondary-branch-prefix' is only active if the primaryprefix is active, it is important to read the secondary prefix beforethe primay since reading the primary can deactivate it."(let((branch(and(cvs-prefix-get'cvs-branch-prefix'read-only)(cvs-prefix-get'cvs-secondary-branch-prefix))))(ifbranch(cons(concat(orarg"-r")branch)flags)flags)));;;;(define-minor-modecvs-minor-mode"This mode is used for buffers related to a main *cvs* buffer.All the `cvs-mode' buffer operations are simply rebound underthe \\[cvs-mode-map] prefix."nil" CVS":group'pcl-cvs)(put'cvs-minor-mode'permanent-localt)(defvarcvs-temp-buffersnil)(defuncvs-temp-buffer(&optionalcmdnormalnosetup)"Create a temporary buffer to run CMD in.If CMD is a string, use it to lookup `cvs-buffer-name-alist' to findthe buffer name to be used and its `major-mode'.The selected window will not be changed. The new buffer will not maintain undoinformation and will be read-only unless NORMAL is non-nil. It will be emptied\(unless NOSETUP is non-nil\) and its `default-directory' will be inheritedfrom the current buffer."(let*((cvs-buf(current-buffer))(info(cdr(assoccmdcvs-buffer-name-alist)))(name(eval(nth0info)))(mode(nth1info))(dirdefault-directory)(buf(cond(name(cvs-get-buffer-createname))((and(bufferpcvs-temp-buffer)(buffer-namecvs-temp-buffer))cvs-temp-buffer)(t(set(make-local-variable'cvs-temp-buffer)(cvs-get-buffer-create(evalcvs-temp-buffer-name)'noreuse))))));; handle the potential pre-existing process(let((proc(get-buffer-processbuf)))(when(and(notnormal)(processpproc)(memq(process-statusproc)'(runstop)))(ifcmd;; When CMD is specified, the buffer is normally shown to the;; user, so interrupting the process is not harmful.;; Use `delete-process' rather than `kill-process' otherwise;; the pending output of the process will still get inserted;; after we erase the buffer.(delete-processproc)(error"Can not run two cvs processes simultaneously"))))(if(notname)(kill-local-variable'other-window-scroll-buffer);; Strangely, if no window is created, `display-buffer' ends up;; doing a `switch-to-buffer' which does a `set-buffer', hence;; the need for `save-excursion'.(unlessnosetup(save-excursion(display-bufferbuf)));; FIXME: this doesn't do the right thing if the user later on;; does a `find-file-other-window' and `scroll-other-window'(set(make-local-variable'other-window-scroll-buffer)buf))(add-to-list'cvs-temp-buffersbuf)(with-current-bufferbuf(setqbuffer-read-onlynil)(setqdefault-directorydir)(unlessnosetup(erase-buffer))(set(make-local-variable'cvs-buffer)cvs-buf);;(cvs-minor-mode 1)(let((lbdlist-buffers-directory))(if(fboundpmode)(funcallmode)(fundamental-mode))(whenlbd(set(make-local-variable'list-buffers-directory)lbd)))(cvs-minor-mode1);;(set (make-local-variable 'cvs-buffer) cvs-buf)(unlessnormal(setqbuffer-read-onlyt)(buffer-disable-undo))buf)))(defuncvs-mode-kill-buffers()"Kill all the \"temporary\" buffers created by the *cvs* buffer."(interactive)(dolist(bufcvs-temp-buffers)(ignore-errors(kill-bufferbuf))))(defuncvs-make-cvs-buffer(dir&optionalnew)"Create the *cvs* buffer for directory DIR.If non-nil, NEW means to create a new buffer no matter what.";; the real cvs-buffer creation(setqdir(cvs-expand-dir-namedir))(let*((buffer-name(evalcvs-buffer-name))(buffer(or(and(notnew)(eqcvs-reuse-cvs-buffer'current)(cvs-buffer-p);reuse the current buffer if possible(current-buffer));; look for another cvs buffer visiting the same directory(save-excursion(unlessnew(dolist(buffer(cons(current-buffer)(buffer-list)))(set-bufferbuffer)(and(cvs-buffer-p)(casecvs-reuse-cvs-buffer(alwayst)(subdir(or(cvs-string-prefix-pdefault-directorydir)(cvs-string-prefix-pdirdefault-directory)))(samedir(string=default-directorydir)))(returnbuffer)))));; we really have to create a new buffer:;; we temporarily bind cwd to "" to prevent;; create-file-buffer from using directory info;; unless it is explicitly in the cvs-buffer-name.(cvs-get-buffer-createbuffer-namenew))))(with-current-bufferbuffer(or(and(string=dirdefault-directory)(cvs-buffer-p);; just a refresh(ignore-errors(cvs-cleanup-collectioncvs-cookiesnilnilt)(current-buffer)));; setup from scratch(progn(setqdefault-directorydir)(setqbuffer-read-onlynil)(erase-buffer)(insert"Repository : "(directory-file-name(cvs-get-cvsroot))"\nModule : "(cvs-get-module)"\nWorking dir: "(abbreviate-file-namedir)(if(not(file-readable-p"CVS/Tag"))"\n"(let((tag(cvs-file-to-string"CVS/Tag")))(cond((string-match"\\`T"tag)(concat"\nTag : "(substringtag1)))((string-match"\\`D"tag)(concat"\nDate : "(substringtag1)))("\n"))))"\n")(setqbuffer-read-onlyt)(cvs-mode)(set(make-local-variable'list-buffers-directory)buffer-name);;(set (make-local-variable 'cvs-temp-buffer) (cvs-temp-buffer))(let((cookies(ewoc-create'cvs-fileinfo-pp"\n""")))(set(make-local-variable'cvs-cookies)cookies)(add-hook'kill-buffer-hook(lambda()(ignore-errors(kill-buffercvs-temp-buffer)))nilt);;(set-buffer buf)buffer))))))(defun*cvs-cmd-do(cmddirflagsfisnew&keycvsargsnoexistdont-change-discnoshow)(let*((dir(file-name-as-directory(abbreviate-file-name(expand-file-namedir))))(cvsbuf(cvs-make-cvs-bufferdirnew)));; Check that dir is under CVS control.(unless(file-directory-pdir)(error"%s is not a directory"dir))(unless(ornoexist(file-directory-p(expand-file-name"CVS"dir))(file-expand-wildcards(expand-file-name"*/CVS"dir)))(error"%s does not contain CVS controlled files"dir))(set-buffercvsbuf)(cvs-mode-runcmdflagsfis:cvsargscvsargs:dont-change-discdont-change-disc)(ifnoshowcvsbuf(let((pop-up-windowsnil))(pop-to-buffercvsbuf)))));; (funcall (if (and (boundp 'pop-up-frames) pop-up-frames);; 'pop-to-buffer 'switch-to-buffer);; cvsbuf))))(defuncvs-run-process(argsfispostprocess&optionalsingle-dir)(assert(cvs-buffer-pcvs-buffer))(save-current-buffer(let((procbuf(current-buffer))(cvsbufcvs-buffer)(single-dir(orsingle-dir(eqcvs-execute-single-dirt))))(set-bufferprocbuf)(goto-char(point-max))(unless(bolp)(let((inhibit-read-onlyt))(insert"\n")));; find the set of files we'll process in this round(let*((dir+files+rest(if(or(nullfis)(notsingle-dir));; not single-dir mode: just process the whole thing(list""(mapcar'cvs-fileinfo->full-pathfis)nil);; single-dir mode: extract the same-dir-elements(let((dir(cvs-fileinfo->dir(carfis))));; output the concerned dir so the parser can translate paths(let((inhibit-read-onlyt))(insert"pcl-cvs: descending directory "dir"\n"));; loop to find the same-dir-elems(do*((files()(cons(cvs-fileinfo->filefi)files))(fisfis(cdrfis))(fi(carfis)(carfis)))((not(andfis(string=dir(cvs-fileinfo->dirfi))))(listdirfilesfis))))))(dir(nth0dir+files+rest))(files(nth1dir+files+rest))(rest(nth2dir+files+rest)));; setup the (current) process buffer(set(make-local-variable'cvs-postprocess)(if(nullrest);; this is the last invocationpostprocess;; else, we have to register ourselves to be rerun on the rest`(cvs-run-process',args',rest',postprocess',single-dir)))(add-hook'kill-buffer-hook(lambda()(let((proc(get-buffer-process(current-buffer))))(when(processpproc)(set-process-filterprocnil)(set-process-sentinelprocnil)(delete-processproc))))nilt);; create the new process and setup the procbuffer correspondingly(let*((args(append(cvs-flags-query'cvs-cvs-flagsnil'noquery)(ifcvs-cvsroot(list"-d"cvs-cvsroot))argsfiles));; If process-connection-type is nil and the repository;; is accessed via SSH, a bad interaction between libc,;; CVS and SSH can lead to garbled output.;; It might be a glibc-specific problem (but it also happens;; under Mac OS X, it seems).;; Until the problem is cleared, we'll use a pty rather than;; a pipe.;; (process-connection-type nil) ; Use a pipe, not a pty.(process;; the process will be run in the selected dir(let((default-directory(cvs-expand-dir-namedir)))(apply'start-process"cvs"procbufcvs-programargs))))(set-process-sentinelprocess'cvs-sentinel)(set-process-filterprocess'cvs-update-filter)(set-marker(process-markprocess)(point-max))(ignore-errors(process-send-eofprocess));close its stdin to avoid hangs;; now finish setting up the cvs-buffer(set-buffercvsbuf)(setqcvs-mode-line-process(symbol-name(process-statusprocess)))(force-mode-line-update)))));; The following line is said to improve display updates on some;; emacsen. It shouldn't be needed, but it does no harm.(sit-for0))(defuncvs-update-header(argsfis); inline(let*((lastargnil)(args(mapcar(lambda(arg)(cond;; filter out the largish commit message((and(eqlastargnil)(string=arg"commit"))(setqlastarg'commit)arg)((and(eqlastarg'commit)(string=arg"-m"))(setqlastarg'-m)arg)((eqlastarg'-m)(setqlastarg'done)"<log message>");; filter out the largish `admin -mrev:msg' message((and(eqlastargnil)(string=arg"admin"))(setqlastarg'admin)arg)((and(eqlastarg'admin)(string-match"\\`-m[^:]*:"arg))(setqlastarg'done)(concat(match-string0arg)"<log message>"));; Keep the rest as is.(targ)))args));; turn them into a string(arg(cvs-strings->string(append(cvs-flags-query'cvs-cvs-flagsnil'noquery)(ifcvs-cvsroot(list"-d"cvs-cvsroot))args(mapcar'cvs-fileinfo->full-pathfis))))(str(ifargs(concat"-- Running "cvs-program" "arg" ...\n")"\n")))(ifnil(insertstr);inline;;(with-current-buffer cvs-buffer(let*((prev-msg(car(ewoc-get-hfcvs-cookies)))(tin(ewoc-nthcvs-cookies0)));; look for the first *real* fileinfo (to determine emptyness)(while(andtin(memq(cvs-fileinfo->type(ewoc-datatin))'(MESSAGEDIRCHANGE)))(setqtin(ewoc-nextcvs-cookiestin)));; cleanup the prev-msg(when(string-match"Running \\(.*\\) ...\n"prev-msg)(setqprev-msg(concat"-- last cmd: "(match-string1prev-msg)" --")));; set the new header and footer(ewoc-set-hfcvs-cookiesstr(concat"\n--------------------- "(iftin"End""Empty")" ---------------------\n"prev-msg))))))(defuncvs-sentinel(procmsg)"Sentinel for the cvs update process.This is responsible for parsing the output from the cvs update whenit is finished."(when(memq(process-statusproc)'(signalexit))(if(null(buffer-name(process-bufferproc)));;(set-process-buffer proc nil)(error"cvs' process buffer was killed")(let*((obuf(current-buffer))(procbuffer(process-bufferproc)))(set-buffer(with-current-bufferprocbuffercvs-buffer))(setqcvs-mode-line-process(symbol-name(process-statusproc)))(force-mode-line-update)(set-bufferprocbuffer)(let((cvs-postproccvs-postprocess));; Since the buffer and mode line will show that the;; process is dead, we can delete it now. Otherwise it;; will stay around until M-x list-processes.(delete-processproc)(setqcvs-postprocessnil);; do the postprocessing like parsing and such(save-excursion(evalcvs-postproc));; check whether something is left(unlesscvs-postprocess;; IIRC, we enable undo again once the process is finished;; for cases where the output was inserted in *vc-diff* or;; in a file-like buffer. -stef(buffer-enable-undo)(with-current-buffercvs-buffer(cvs-update-headernilnil);FIXME: might need to be inline(message"CVS process has completed in %s"(buffer-name)))));; This might not even be necessary(set-bufferobuf)))))(defuncvs-parse-process(dcd&optionalsubdirold-fis)"Parse the output of a cvs process.DCD is the `dont-change-disc' flag to use when parsing that output.SUBDIR is the subdirectory (if any) where this command was run.OLD-FIS is the list of fileinfos on which the cvs command was applied and which should be considered up-to-date if they are missing from the output."(let*((fileinfos(cvs-parse-buffer'cvs-parse-tabledcdsubdir))last)(with-current-buffercvs-buffer;; Expand OLD-FIS to actual files.(let((fisnil))(dolist(fiold-fis)(setqfis(if(eq(cvs-fileinfo->typefi)'DIRCHANGE)(nconc(ewoc-collectcvs-cookies'cvs-dir-member-p(cvs-fileinfo->dirfi))fis)(consfifis))))(setqold-fisfis));; Drop OLD-FIS which were already up-to-date.(let((fisnil))(dolist(fiold-fis)(unless(eq(cvs-fileinfo->typefi)'UP-TO-DATE)(pushfifis)))(setqold-fisfis));; Add the new fileinfos to the ewoc.(dolist(fifileinfos)(setqlast(cvs-addto-collectioncvs-cookiesfilast));; This FI was in the output, so remove it from OLD-FIS.(setqold-fis(delq(ewoc-datalast)old-fis)));; Process the "silent output" (i.e. absence means up-to-date).(dolist(fiold-fis)(setf(cvs-fileinfo->typefi)'UP-TO-DATE)(setqlast(cvs-addto-collectioncvs-cookiesfilast)))(setqfileinfos(nconcold-fisfileinfos));; Clean up the ewoc as requested by the user.(cvs-cleanup-collectioncvs-cookies(eqcvs-auto-remove-handledt)cvs-auto-remove-directoriesnil);; Revert buffers if necessary.(when(andcvs-auto-revert(notdcd)(notcvs-from-vc))(cvs-revert-if-neededfileinfos)))))(defmacrodefun-cvs-mode(funargsdocstringinteract&restbody)"Define a function to be used in a *cvs* buffer.This will look for a *cvs* buffer and execute BODY in it.Since the interactive arguments might need to be queried afterswitching to the *cvs* buffer, the generic code is rather ugly,but luckily we can often use simpler alternatives.FUN can be either a symbol (i.e. STYLE is nil) or a cons (FUN . STYLE).ARGS and DOCSTRING are the normal argument list.INTERACT is the interactive specification or nil for non-commands.STYLE can be either SIMPLE, NOARGS or DOUBLE. It's an error for itto have any other value, unless other details of the function make itclear what alternative to use.- SIMPLE will get all the interactive arguments from the original buffer.- NOARGS will get all the arguments from the *cvs* buffer and will always behave as if called interactively.- DOUBLE is the generic case."(declare(debug(&definesexplambda-liststringp("interactive"interactive)def-body)))(let((style(cvs-cdrfun))(fun(cvs-carfun)))(cond;; a trivial interaction, no need to move it((or(eqstyle'SIMPLE)(null(nth1interact))(stringp(nth1interact)))`(defun,fun,args,docstring,interact(cvs-mode!(lambda(),@body))));; fun is only called interactively: move all the args to the inner fun((eqstyle'NOARGS)`(defun,fun(),docstring(interactive)(cvs-mode!(lambda,args,interact,@body))));; bad case((eqstyle'DOUBLE)(string-match".*"docstring)(let((line1(match-string0docstring))(fun-1(intern(concat(symbol-namefun)"-1"))))`(progn(defun,fun-1,args,(concatdocstring"\nThis function only works within a *cvs* buffer.For interactive use, use `"(symbol-namefun)"' instead."),interact,@body)(defun,fun(),(concatline1"\nWrapper function that switches to a *cvs* bufferbefore calling the real function `"(symbol-namefun-1)"'.\n")(interactive)(cvs-mode!',fun-1)))))(t(error"unknown style %s in `defun-cvs-mode'"style)))))(defun-cvs-modecvs-mode-kill-process()"Kill the temporary buffer and associated process."(interactive)(when(and(bufferpcvs-temp-buffer)(buffer-namecvs-temp-buffer))(let((proc(get-buffer-processcvs-temp-buffer)))(whenproc(delete-processproc)))));;;; Maintaining the collection in the face of updates;;(defuncvs-addto-collection(cfi&optionaltin)"Add FI to C and return FI's corresponding tin.FI is inserted in its proper place or maybe even merged with a preexisting fileinfo if applicable.TIN specifies an optional starting point."(unlesstin(setqtin(ewoc-nthc0)))(while(andtin(cvs-fileinfo<fi(ewoc-datatin)))(setqtin(ewoc-prevctin)))(if(nulltin)(ewoc-enter-firstcfi);empty collection(assert(not(cvs-fileinfo<fi(ewoc-datatin))))(let((next-tin(ewoc-nextctin)))(while(not(or(nullnext-tin)(cvs-fileinfo<fi(ewoc-datanext-tin))))(setqtinnext-tinnext-tin(ewoc-nextcnext-tin)))(if(or(cvs-fileinfo<(ewoc-datatin)fi)(eq(cvs-fileinfo->typefi)'MESSAGE));; tin < fi < next-tin(ewoc-enter-afterctinfi);; fi == tin(cvs-fileinfo-update(ewoc-datatin)fi)(ewoc-invalidatectin);; Move cursor back to where it belongs.(when(bolp)(cvs-move-to-goal-column))tin))))(defcustomcvs-cleanup-functionsnil"Functions to tweak the cleanup process.The functions are called with a single argument (a FILEINFO) and shouldreturn a non-nil value if that fileinfo should be removed.":group'pcl-cvs:type'(hook:options(cvs-cleanup-removed)))(defuncvs-cleanup-removed(fi)"Non-nil if FI has been cvs-removed but still exists.This is intended for use on `cvs-cleanup-functions' when you have cvs-removedautomatically generated files (which should hence not be under CVS control)but can't commit the removal because the repository's owner doesn't understandthe problem."(and(or(eq(cvs-fileinfo->typefi)'REMOVED)(and(eq(cvs-fileinfo->typefi)'CONFLICT)(eq(cvs-fileinfo->subtypefi)'REMOVED)))(file-exists-p(cvs-fileinfo->full-pathfi))));; called at the following times:;; - postparse ((eq cvs-auto-remove-handled t) cvs-auto-remove-directories nil);; - pre-run ((eq cvs-auto-remove-handled 'delayed) nil t);; - remove-handled (t (or cvs-auto-remove-directories 'handled) t);; - cvs-cmd-do (nil nil t);; - post-ignore (nil nil nil);; - acknowledge (nil nil nil);; - remove (nil nil nil)(defuncvs-cleanup-collection(crm-handledrm-dirsrm-msgs)"Remove undesired entries.C is the collectionRM-HANDLED if non-nil means remove handled entries.RM-DIRS behaves like `cvs-auto-remove-directories'.RM-MSGS if non-nil means remove messages."(let(last-fifirst-dir(rerunt))(whilererun(setqrerunnil)(setqfirst-dirt)(setqlast-fi(cvs-create-fileinfo'DEAD"../"""""));place-holder(ewoc-filterc(lambda(fi)(let*((type(cvs-fileinfo->typefi))(subtype(cvs-fileinfo->subtypefi))(keep(casetype;; remove temp messages and keep the others(MESSAGE(not(orrm-msgs(eqsubtype'TEMP))));; remove entries(DEADnil);; handled also?(UP-TO-DATE(notrm-handled));; keep the rest(t(not(run-hook-with-args-until-success'cvs-cleanup-functionsfi))))));; mark dirs for removal(when(andkeeprm-dirs(eq(cvs-fileinfo->typelast-fi)'DIRCHANGE)(not(whenfirst-dir(setqfirst-dirnil)t))(or(eqrm-dirs'all)(not(cvs-string-prefix-p(cvs-fileinfo->dirlast-fi)(cvs-fileinfo->dirfi)))(and(eqtype'DIRCHANGE)(eqrm-dirs'empty))(eqsubtype'FOOTER)))(setf(cvs-fileinfo->typelast-fi)'DEAD)(setqrerunt))(whenkeep(setqlast-fifi)))));; remove empty last dir(when(andrm-dirs(notfirst-dir)(eq(cvs-fileinfo->typelast-fi)'DIRCHANGE))(setf(cvs-fileinfo->typelast-fi)'DEAD)(setqrerunt)))))(defuncvs-get-cvsroot()"Gets the CVSROOT for DIR."(let((cvs-cvsroot-file(expand-file-name"Root""CVS")))(or(cvs-file-to-stringcvs-cvsroot-filet)cvs-cvsroot(getenv"CVSROOT")"?????")))(defuncvs-get-module()"Return the current CVS module.This usually doesn't really work but is a handy initval in a prompt."(let*((repfile(expand-file-name"Repository""CVS"))(rep(cvs-file-to-stringrepfilet)))(cond((nullrep)"")((not(file-name-absolute-prep))rep)(t(let*((root(cvs-get-cvsroot))(str(concat(file-name-as-directory(orroot"/"))" || "rep)))(if(androot(string-match"\\(.*\\) || \\1\\(.*\\)\\'"str))(match-string2str)(file-name-nondirectoryrep)))))));;;;;;;; running a "cvs checkout".;;;;;;;###autoload(defuncvs-checkout(modulesdirflags)"Run a 'cvs checkout MODULES' in DIR.Feed the output to a *cvs* buffer, display it in the current window,and run `cvs-mode' on it.With a prefix argument, prompt for cvs FLAGS to use."(interactive(list(cvs-string->strings(read-string"Module(s): "(cvs-get-module)))(read-directory-name"CVS Checkout Directory: "nildefault-directorynil)(cvs-add-branch-prefix(cvs-flags-query'cvs-checkout-flags"cvs checkout flags"))))(when(eqflagst)(setfflags(cvs-flags-query'cvs-checkout-flagsnil'noquery)))(cvs-cmd-do"checkout"(ordirdefault-directory)(appendflagsmodules)nil'new:noexistt));;;;;;;; The code for running a "cvs update" and friends in various ways.;;;;(defun-cvs-mode(cvs-mode-revert-buffer.SIMPLE)(&optionalignore-autonoconfirm)"Rerun `cvs-examine' on the current directory with the default flags."(interactive)(cvs-examinedefault-directoryt))(defuncvs-query-directory(msg);; last-command-char = ?\r hints that the command was run via M-x(if(and(cvs-buffer-p)(notcurrent-prefix-arg)(not(eqlast-command-char?\r)))default-directory(read-directory-namemsgnildefault-directorynil)));;;###autoload(defuncvs-quickdir(dir&optionalflagsnoshow)"Open a *cvs* buffer on DIR without running cvs.With a prefix argument, prompt for a directory to use.A prefix arg >8 (ex: \\[universal-argument] \\[universal-argument]), prevents reuse of an existing *cvs* buffer.Optional argument NOSHOW if non-nil means not to display the buffer.FLAGS is ignored."(interactive(list(cvs-query-directory"CVS quickdir (directory): ")));; FIXME: code duplication with cvs-cmd-do and cvs-parse-process(let*((dir(file-name-as-directory(abbreviate-file-name(expand-file-namedir))))(new(>(prefix-numeric-valuecurrent-prefix-arg)8))(cvsbuf(cvs-make-cvs-bufferdirnew))last);; Check that dir is under CVS control.(unless(file-directory-pdir)(error"%s is not a directory"dir))(unless(file-directory-p(expand-file-name"CVS"dir))(error"%s does not contain CVS controlled files"dir))(set-buffercvsbuf)(dolist(fi(cvs-fileinfo-from-entries""))(setqlast(cvs-addto-collectioncvs-cookiesfilast)))(cvs-cleanup-collectioncvs-cookies(eqcvs-auto-remove-handledt)cvs-auto-remove-directoriesnil)(ifnoshowcvsbuf(let((pop-up-windowsnil))(pop-to-buffercvsbuf)))));;;###autoload(defuncvs-examine(directoryflags&optionalnoshow)"Run a `cvs -n update' in the specified DIRECTORY.That is, check what needs to be done, but don't change the disc.Feed the output to a *cvs* buffer and run `cvs-mode' on it.With a prefix argument, prompt for a directory and cvs FLAGS to use.A prefix arg >8 (ex: \\[universal-argument] \\[universal-argument]), prevents reuse of an existing *cvs* buffer.Optional argument NOSHOW if non-nil means not to display the buffer."(interactive(list(cvs-query-directory"CVS Examine (directory): ")(cvs-flags-query'cvs-update-flags"cvs -n update flags")))(when(eqflagst)(setfflags(cvs-flags-query'cvs-update-flagsnil'noquery)))(whenfind-file-visit-truename(setqdirectory(file-truenamedirectory)))(cvs-cmd-do"update"directoryflagsnil(>(prefix-numeric-valuecurrent-prefix-arg)8):cvsargs'("-n"):noshownoshow:dont-change-disct));;;###autoload(defuncvs-update(directoryflags)"Run a `cvs update' in the current working DIRECTORY.Feed the output to a *cvs* buffer and run `cvs-mode' on it.With a \\[universal-argument] prefix argument, prompt for a directory to use.A prefix arg >8 (ex: \\[universal-argument] \\[universal-argument]), prevents reuse of an existing *cvs* buffer.The prefix is also passed to `cvs-flags-query' to select the FLAGS passed to cvs."(interactive(list(cvs-query-directory"CVS Update (directory): ")(cvs-flags-query'cvs-update-flags"cvs update flags")))(when(eqflagst)(setfflags(cvs-flags-query'cvs-update-flagsnil'noquery)))(cvs-cmd-do"update"directoryflagsnil(>(prefix-numeric-valuecurrent-prefix-arg)8)));;;###autoload(defuncvs-status(directoryflags&optionalnoshow)"Run a `cvs status' in the current working DIRECTORY.Feed the output to a *cvs* buffer and run `cvs-mode' on it.With a prefix argument, prompt for a directory and cvs FLAGS to use.A prefix arg >8 (ex: \\[universal-argument] \\[universal-argument]), prevents reuse of an existing *cvs* buffer.Optional argument NOSHOW if non-nil means not to display the buffer."(interactive(list(cvs-query-directory"CVS Status (directory): ")(cvs-flags-query'cvs-status-flags"cvs status flags")))(when(eqflagst)(setfflags(cvs-flags-query'cvs-status-flagsnil'noquery)))(cvs-cmd-do"status"directoryflagsnil(>(prefix-numeric-valuecurrent-prefix-arg)8):noshownoshow:dont-change-disct))(defuncvs-update-filter(procstring)"Filter function for pcl-cvs.This function gets the output that CVS sends to stdout. It insertsthe STRING into (process-buffer PROC) but it also checks if CVS is waitingfor a lock file. If so, it inserts a message cookie in the *cvs* buffer."(save-match-data(with-current-buffer(process-bufferproc)(let((inhibit-read-onlyt))(save-excursion;; Insert the text, moving the process-marker.(goto-char(process-markproc))(insertstring)(set-marker(process-markproc)(point));; FIXME: Delete any old lock message;;(if (tin-nth cookies 1);; (tin-delete cookies;; (tin-nth cookies 1)));; Check if CVS is waiting for a lock.(beginning-of-line0);Move to beginning of last complete line.(when(looking-at"^[ a-z]+: \\(.*waiting for .*lock in \\(.*\\)\\)$")(let((msg(match-string1))(lock(match-string2)))(with-current-buffercvs-buffer(set(make-local-variable'cvs-lock-file)lock);; display the lock situation in the *cvs* buffer:(ewoc-enter-lastcvs-cookies(cvs-create-fileinfo'MESSAGE""" "(concatmsg(when(file-exists-plock)(substitute-command-keys"\n\t(type \\[cvs-mode-delete-lock] to delete it)"))):subtype'TEMP))(pop-to-buffer(current-buffer))(goto-char(point-max))(beep)))))))));;;;;;;; The cvs-mode and its associated commands.;;;;(cvs-prefix-definecvs-force-command""""'("/F")cvs-qtypedesc-string1)(defun-cvs-modecvs-mode-force-command(arg)"Force the next cvs command to operate on all the selected files.By default, cvs commands only operate on files on which the command\"makes sense\". This overrides the safety feature on the next cvs command.It actually behaves as a toggle. If prefixed by \\[universal-argument] \\[universal-argument],the override will persist until the next toggle."(interactive"P")(cvs-prefix-set'cvs-force-commandarg))(put'cvs-mode'mode-class'special)(define-derived-modecvs-modenil"CVS""Mode used for PCL-CVS, a frontend to CVS.Full documentation is in the Texinfo file."(setqmode-line-process'(""cvs-force-commandcvs-ignore-marks-modif":"(cvs-branch-prefix(""cvs-branch-prefix(cvs-secondary-branch-prefix("->"cvs-secondary-branch-prefix))))" "cvs-mode-line-process))(ifbuffer-file-name(error"Use M-x cvs-quickdir to get a *cvs* buffer."))(buffer-disable-undo);;(set (make-local-variable 'goal-column) cvs-cursor-column)(set(make-local-variable'revert-buffer-function)'cvs-mode-revert-buffer)(setqtruncate-linest)(cvs-prefix-make-local'cvs-branch-prefix)(cvs-prefix-make-local'cvs-secondary-branch-prefix)(cvs-prefix-make-local'cvs-force-command)(cvs-prefix-make-local'cvs-ignore-marks-modif)(make-local-variable'cvs-mode-line-process)(make-local-variable'cvs-temp-buffers))(defuncvs-buffer-p(&optionalbuffer)"Return whether the (by default current) BUFFER is a `cvs-mode' buffer."(save-excursion(ifbuffer(set-bufferbuffer))(and(eqmajor-mode'cvs-mode))))(defuncvs-buffer-check()"Check that the current buffer follows cvs-buffer's conventions."(let((buf(current-buffer))(check'none))(or(and(setqcheck'collection)(eq(ewoc-buffercvs-cookies)buf)(setqcheck'cvs-temp-buffer)(or(nullcvs-temp-buffer)(null(buffer-namecvs-temp-buffer))(and(eq(with-current-buffercvs-temp-buffercvs-buffer)buf)(equal(with-current-buffercvs-temp-bufferdefault-directory)default-directory)))t)(error"Inconsistent %s in buffer %s"check(buffer-namebuf)))))(defuncvs-mode-quit()"Quit PCL-CVS, killing the *cvs* buffer."(interactive)(and(y-or-n-p"Quit pcl-cvs? ")(kill-buffer(current-buffer))));; Give help....(defuncvs-help()"Display help for various PCL-CVS commands."(interactive)(if(eqlast-command'cvs-help)(describe-function'cvs-mode); would need minor-mode for log-edit-mode(message(substitute-command-keys"`\\[cvs-help]':help `\\[cvs-mode-add]':add `\\[cvs-mode-commit]':commit \`\\[cvs-mode-diff-map]':diff* `\\[cvs-mode-log]':log \`\\[cvs-mode-remove]':remove `\\[cvs-mode-status]':status \`\\[cvs-mode-undo]':undo"))));; Move around in the buffer(defuncvs-move-to-goal-column()(let*((eol(line-end-position))(fpos(next-single-property-change(point)'cvs-goal-columnnileol)))(when(<fposeol)(goto-charfpos))))(defun-cvs-modecvs-mode-previous-line(arg)"Go to the previous line.If a prefix argument is given, move by that many lines."(interactive"p")(ewoc-goto-prevcvs-cookiesarg)(cvs-move-to-goal-column))(defun-cvs-modecvs-mode-next-line(arg)"Go to the next line.If a prefix argument is given, move by that many lines."(interactive"p")(ewoc-goto-nextcvs-cookiesarg)(cvs-move-to-goal-column));;;;;;;; Mark handling;;;;(defun-cvs-modecvs-mode-mark(&optionalarg)"Mark the fileinfo on the current line.If the fileinfo is a directory, all the contents of that directory aremarked instead. A directory can never be marked."(interactive)(let*((tin(ewoc-locatecvs-cookies))(fi(ewoc-datatin)))(if(eq(cvs-fileinfo->typefi)'DIRCHANGE);; it's a directory: let's mark all files inside(ewoc-map(lambda(fdir)(when(cvs-dir-member-pfdir)(setf(cvs-fileinfo->markedf)(not(if(eqarg'toggle)(cvs-fileinfo->markedf)arg)))t));Tell cookie to redisplay this cookie.cvs-cookies(cvs-fileinfo->dirfi));; not a directory: just do the obvious(setf(cvs-fileinfo->markedfi)(not(if(eqarg'toggle)(cvs-fileinfo->markedfi)arg)))(ewoc-invalidatecvs-cookiestin)(cvs-mode-next-line1))))(defuncvs-mouse-toggle-mark(e)"Toggle the mark of the entry under the mouse."(interactive"e")(save-excursion(mouse-set-pointe)(cvs-mode-mark'toggle)))(defun-cvs-modecvs-mode-unmark()"Unmark the fileinfo on the current line."(interactive)(cvs-mode-markt))(defun-cvs-modecvs-mode-mark-all-files()"Mark all files."(interactive)(ewoc-map(lambda(cookie)(unless(eq(cvs-fileinfo->typecookie)'DIRCHANGE)(setf(cvs-fileinfo->markedcookie)t)))cvs-cookies))(defun-cvs-mode(cvs-mode-mark-on-state.SIMPLE)(state)"Mark all files in state STATE."(interactive(list(let((default(condition-casenil(downcase(symbol-name(cvs-fileinfo->type(cvs-mode-markednilnil:read-onlyt:onet:noqueryt))))(errornil))))(intern(upcase(completing-read(concat"Mark files in state"(ifdefault(concat" ["default"]"))": ")(mapcar(lambda(x)(list(downcase(symbol-name(carx)))))cvs-states)niltnilnildefault))))))(ewoc-map(lambda(fi)(when(eq(cvs-fileinfo->typefi)state)(setf(cvs-fileinfo->markedfi)t)))cvs-cookies))(defun-cvs-modecvs-mode-mark-matching-files(regex)"Mark all files matching REGEX."(interactive"sMark files matching: ")(ewoc-map(lambda(cookie)(when(and(not(eq(cvs-fileinfo->typecookie)'DIRCHANGE))(string-matchregex(cvs-fileinfo->filecookie)))(setf(cvs-fileinfo->markedcookie)t)))cvs-cookies))(defun-cvs-modecvs-mode-unmark-all-files()"Unmark all files.Directories are also unmarked, but that doesn't matter, sincethey should always be unmarked."(interactive)(ewoc-map(lambda(cookie)(setf(cvs-fileinfo->markedcookie)nil)t)cvs-cookies))(defun-cvs-modecvs-mode-unmark-up()"Unmark the file on the previous line."(interactive)(let((tin(ewoc-goto-prevcvs-cookies1)))(whentin(setf(cvs-fileinfo->marked(ewoc-datatin))nil)(ewoc-invalidatecvs-cookiestin))))(defconstcvs-ignore-marks-alternatives'(("toggle-marks"."/TM")("force-marks"."/FM")("ignore-marks"."/IM")))(cvs-prefix-definecvs-ignore-marks-modif"Prefix to decide whether to ignore marks or not.""active"(mapcar'cdrcvs-ignore-marks-alternatives)(cvs-qtypedesc-create(lambda(str)(cdr(assocstrcvs-ignore-marks-alternatives)))(lambda(obj)(car(rassocobjcvs-ignore-marks-alternatives)))(lambda()cvs-ignore-marks-alternatives)nilt))(defun-cvs-modecvs-mode-toggle-marks(arg)"Toggle whether the next CVS command uses marks.See `cvs-prefix-set' for further description of the behavior.\\[universal-argument] 1 selects `force-marks',\\[universal-argument] 2 selects `ignore-marks',\\[universal-argument] 3 selects `toggle-marks'."(interactive"P")(cvs-prefix-set'cvs-ignore-marks-modifarg))(defuncvs-ignore-marks-p(cmd&optionalread-only)(let((default(if(membercmdcvs-invert-ignore-marks)(notcvs-default-ignore-marks)cvs-default-ignore-marks))(modif(cvs-prefix-get'cvs-ignore-marks-modifread-only)))(cond((equalmodif"/IM")t)((equalmodif"/TM")(notdefault))((equalmodif"/FM")nil)(tdefault))))(defuncvs-mode-mark-get-modif(cmd)(if(cvs-ignore-marks-pcmd'read-only)"/IM""/FM"))(defuncvs-get-marked(&optionalignore-marksignore-contents)"Return a list of all selected fileinfos.If there are any marked tins, and IGNORE-MARKS is nil, return them.Otherwise, if the cursor selects a directory, and IGNORE-CONTENTS isnil, return all files in it, else return just the directory.Otherwise return (a list containing) the file the cursor points to, oran empty list if it doesn't point to a file at all.Args: &optional IGNORE-MARKS IGNORE-CONTENTS."(let((fisnil))(dolist(fi(if(and(boundp'cvs-minor-current-files)(conspcvs-minor-current-files))(mapcar(lambda(f)(if(cvs-fileinfo-pf)f(let((f(file-relative-namef)))(if(file-directory-pf)(cvs-create-fileinfo'DIRCHANGE(file-name-as-directoryf)".""")(let((dir(file-name-directoryf))(file(file-name-nondirectoryf)))(cvs-create-fileinfo'UNKNOWN(ordir"")file""))))))cvs-minor-current-files)(or(and(notignore-marks)(ewoc-collectcvs-cookies'cvs-fileinfo->marked))(list(ewoc-data(ewoc-locatecvs-cookies))))))(if(orignore-contents(not(eq(cvs-fileinfo->typefi)'DIRCHANGE)))(pushfifis);; If a directory is selected, return members, if any.(setqfis(append(ewoc-collectcvs-cookies'cvs-dir-member-p(cvs-fileinfo->dirfi))fis))))(nreversefis)))(defun*cvs-mode-marked(filter&optionalcmd&keyread-onlyonefilenoquery)"Get the list of marked FIS.CMD is used to determine whether to use the marks or not.Only files for which FILTER is applicable are returned.If READ-ONLY is non-nil, the current toggling is left intact.If ONE is non-nil, marks are ignored and a single FI is returned.If FILE is non-nil, directory entries won't be selected."(unlesscmd(setqcmd(symbol-namefilter)))(let*((fis(cvs-get-marked(orone(cvs-ignore-marks-pcmdread-only))(and(notfile)(cvs-applicable-p'DIRCHANGEfilter))))(force(cvs-prefix-get'cvs-force-command))(fis(car(cvs-partition(lambda(fi)(cvs-applicable-pfi(and(notforce)filter)))fis))))(when(and(or(nullfis)(andone(cdrfis)))(notnoquery))(message(if(nullfis)"`%s' is not applicable to any of the selected files.""`%s' is only applicable to a single file.")cmd)(sit-for1)(setqfis(list(cvs-insert-file(read-file-name(format"File to %s: "cmd))))))(ifone(carfis)fis)))(defuncvs-enabledp(filter)"Determine whether FILTER applies to at least one of the selected files."(ignore-errors(cvs-mode-markedfilternil:read-onlyt:noqueryt)))(defuncvs-mode-files(&rest-cvs-mode-files-args)(cvs-mode!(lambda()(mapcar'cvs-fileinfo->full-path(apply'cvs-mode-marked-cvs-mode-files-args)))));;;; Interface between Log-Edit and PCL-CVS;;(defuncvs-mode-commit-setup()"Run `cvs-mode-commit' with setup."(interactive)(cvs-mode-commit'force))(defcustomcvs-mode-commit-hooknil"Hook run after setting up the commit buffer.":type'hook:options'(cvs-mode-diff):group'pcl-cvs)(defuncvs-mode-commit(setup)"Check in all marked files, or the current file.The user will be asked for a log message in a buffer.The buffer's mode and name is determined by the \"message\" setting of `cvs-buffer-name-alist'.The POSTPROC specified there (typically `log-edit') is then called, passing it the SETUP argument."(interactive"P");; It seems that the save-excursion that happens if I use the better;; form of `(cvs-mode! (lambda ...))' screws up a couple things which;; end up being rather annoying (like log-edit-mode's message being;; displayed in the wrong minibuffer).(cvs-mode!)(let((buf(cvs-temp-buffer"message"'normal'nosetup))(lbdlist-buffers-directory)(setupfun(or(nth2(cdr(assoc"message"cvs-buffer-name-alist)))'log-edit)))(funcallsetupfun'cvs-do-commitsetup'cvs-commit-filelistbuf)(set(make-local-variable'cvs-minor-wrap-function)'cvs-commit-minor-wrap)(set(make-local-variable'list-buffers-directory)lbd)(run-hooks'cvs-mode-commit-hook)))(defuncvs-commit-minor-wrap(buff)(let((cvs-ignore-marks-modif(cvs-mode-mark-get-modif"commit")))(funcallf)))(defuncvs-commit-filelist()(cvs-mode-files'commitnil:read-onlyt:filet:noqueryt))(defuncvs-do-commit(flags)"Do the actual commit, using the current buffer as the log message."(interactive(list(cvs-flags-query'cvs-commit-flags"cvs commit flags")))(let((msg(buffer-substring-no-properties(point-min)(point-max))))(cvs-mode!);;(pop-to-buffer cvs-buffer)(cvs-mode-do"commit"(list*"-m"msgflags)'commit)));;;; Editing existing commit log messages.(defuncvs-edit-log-text-at-point()(save-excursion(end-of-line)(when(re-search-backward"^revision "nilt)(forward-line1)(if(looking-at"date:")(forward-line1))(if(looking-at"branches:")(forward-line1))(buffer-substring(point)(if(re-search-forward"^\\(-\\{28\\}\\|=\\{77\\}\\|revision [.0-9]+\\)$"nilt)(match-beginning0)(point))))))(defvarcvs-edit-log-revision)(defuncvs-mode-edit-log(rev&optionaltext)"Edit the log message at point.This is best called from a `log-view-mode' buffer."(interactive(list(or(cvs-mode!(lambda()(cvs-prefix-get'cvs-branch-prefix)))(read-string"Revision to edit: "))(cvs-edit-log-text-at-point)));; It seems that the save-excursion that happens if I use the better;; form of `(cvs-mode! (lambda ...))' screws up a couple things which;; end up being rather annoying (like log-edit-mode's message being;; displayed in the wrong minibuffer).(cvs-mode!)(let((buf(cvs-temp-buffer"message"'normal'nosetup))(lbdlist-buffers-directory)(setupfun(or(nth2(cdr(assoc"message"cvs-buffer-name-alist)))'log-edit)))(funcallsetupfun'cvs-do-edit-lognil'cvs-edit-log-filelistbuf)(whentext(erase-buffer)(inserttext))(set(make-local-variable'cvs-edit-log-revision)rev)(set(make-local-variable'cvs-minor-wrap-function)'cvs-edit-log-minor-wrap)(set(make-local-variable'list-buffers-directory)lbd);; (run-hooks 'cvs-mode-commit-hook)))(defuncvs-edit-log-minor-wrap(buff)(let((cvs-ignore-marks-modif(cvs-mode-mark-get-modif"commit")))(funcallf)))(defuncvs-edit-log-filelist()(cvs-mode-filesnilnil:read-onlyt:filet:noqueryt))(defuncvs-do-edit-log(rev)"Do the actual commit, using the current buffer as the log message."(interactive(listcvs-edit-log-revision))(let((msg(buffer-substring-no-properties(point-min)(point-max))))(cvs-mode!)(cvs-mode-do"admin"(list(concat"-m"rev":"msg))nil)));;;;;;;; CVS Mode commands;;;;(defun-cvs-mode(cvs-mode-insert.NOARGS)(file)"Insert an entry for a specific file into the current listing.This is typically used if the file is up-to-date (or has been addedoutside of PCL-CVS) and one wants to do some operation on it."(interactive(list(read-file-name"File to insert: ";; Can't use ignore-errors here because interactive;; specs aren't byte-compiled.(condition-casenil(file-name-as-directory(expand-file-name(cvs-fileinfo->dir(cvs-mode-markednilnil:read-onlyt:onet:noqueryt))))(errornil)))))(cvs-insert-filefile))(defuncvs-insert-file(file)"Insert FILE (and its contents if it's a dir) and return its FI."(let((file(file-relative-name(directory-file-namefile)))last)(dolist(fi(cvs-fileinfo-from-entriesfile))(setqlast(cvs-addto-collectioncvs-cookiesfilast)));; There should have been at least one entry.(goto-char(ewoc-locationlast))(ewoc-datalast)))(defuncvs-mark-fis-dead(fis);; Helper function, introduced because of the need for macro-expansion.(dolist(fifis)(setf(cvs-fileinfo->typefi)'DEAD)))(defun-cvs-mode(cvs-mode-add.SIMPLE)(flags)"Add marked files to the cvs repository.With prefix argument, prompt for cvs flags."(interactive(list(cvs-flags-query'cvs-add-flags"cvs add flags")))(let((fis(cvs-mode-marked'add))(needdescnil)(dirsnil));; find directories and look for fis needing a description(dolist(fifis)(cond((file-directory-p(cvs-fileinfo->full-pathfi))(pushfidirs))((eq(cvs-fileinfo->typefi)'UNKNOWN)(setqneeddesct))));; prompt for description if necessary(let*((msg(if(andneeddesc(orcurrent-prefix-arg(notcvs-add-default-message)))(read-from-minibuffer"Enter description: ")(orcvs-add-default-message"")))(flags(list*"-m"msgflags))(postproc;; setup postprocessing for the directory entries(whendirs`((cvs-run-process(list"-n""update")',dirs'(cvs-parse-processt))(cvs-mark-fis-dead',dirs)))))(cvs-mode-run"add"flagsfis:postprocpostproc))))(defun-cvs-mode(cvs-mode-diff.DOUBLE)(flags)"Diff the selected files against the repository.This command compares the files in your working area against therevision which they are based upon."(interactive(list(cvs-add-branch-prefix(cvs-add-secondary-branch-prefix(cvs-flags-query'cvs-diff-flags"cvs diff flags")))))(cvs-mode-do"diff"flags'diff:showt));; :ignore-exit t(defun-cvs-mode(cvs-mode-diff-head.SIMPLE)(flags)"Diff the selected files against the head of the current branch.See ``cvs-mode-diff'' for more info."(interactive(list(cvs-flags-query'cvs-diff-flags"cvs diff flags")))(cvs-mode-diff-1(cons"-rHEAD"flags)))(defun-cvs-mode(cvs-mode-diff-vendor.SIMPLE)(flags)"Diff the selected files against the head of the vendor branch.See ``cvs-mode-diff'' for more info."(interactive(list(cvs-flags-query'cvs-diff-flags"cvs diff flags")))(cvs-mode-diff-1(cons(concat"-r"cvs-vendor-branch)flags)));; sadly, this is not provided by cvs, so we have to roll our own(defun-cvs-mode(cvs-mode-diff-backup.SIMPLE)(flags)"Diff the files against the backup file.This command can be used on files that are marked with \"Merged\"or \"Conflict\" in the *cvs* buffer."(interactive(list(cvs-flags-query'cvs-diff-flags"diff flags")))(unless(listpflags)(error"flags should be a list of strings"))(save-some-buffers)(let*((marked(cvs-get-marked(cvs-ignore-marks-p"diff")))(fis(car(cvs-partition'cvs-fileinfo->backup-filemarked))))(unless(conspfis)(error"No files with a backup file selected!"));; let's extract some info into the environment for `buffer-name'(let*((dir(cvs-fileinfo->dir(carfis)))(file(cvs-fileinfo->file(carfis))))(set-buffer(cvs-temp-buffer"diff")))(message"cvs diff backup...")(cvs-execute-single-file-listfis'cvs-diff-backup-extractorcvs-diff-programflags))(message"cvs diff backup... Done."))(defuncvs-diff-backup-extractor(fileinfo)"Return the filename and the name of the backup file as a list.Signal an error if there is no backup file."(let((backup-file(cvs-fileinfo->backup-filefileinfo)))(unlessbackup-file(error"%s has no backup file"(cvs-fileinfo->full-pathfileinfo)))(listbackup-file(cvs-fileinfo->full-pathfileinfo))));;;; Emerge support;;(defuncvs-emerge-diff(b1b2)(emerge-buffersb1b2b1))(defuncvs-emerge-merge(b1b2baseout)(emerge-buffers-with-ancestorb1b2base(find-file-noselectout)));;;; Ediff support;;(defvarediff-after-quit-destination-buffer)(defvarediff-after-quit-hook-internal)(defvarcvs-transient-buffers)(defuncvs-ediff-startup-hook()(add-hook'ediff-after-quit-hook-internal`(lambda()(cvs-ediff-exit-hook',ediff-after-quit-destination-buffer',cvs-transient-buffers))nil'local))(defuncvs-ediff-exit-hook(cvs-buftmp-bufs);; kill the temp buffers (and their associated windows)(dolist(tbtmp-bufs)(when(andtb(buffer-live-ptb)(not(buffer-modified-ptb)))(let((win(get-buffer-windowtbt)))(kill-buffertb)(when(window-live-pwin)(ignore-errors(delete-windowwin))))));; switch back to the *cvs* buffer(when(andcvs-buf(buffer-live-pcvs-buf)(not(get-buffer-windowcvs-buft)))(ignore-errors(switch-to-buffercvs-buf))))(defuncvs-ediff-diff(b1b2)(let((ediff-after-quit-destination-buffer(current-buffer))(startup-hook'(cvs-ediff-startup-hook)))(ediff-buffersb1b2startup-hook'ediff-revision)))(defuncvs-ediff-merge(b1b2baseout)(let((ediff-after-quit-destination-buffer(current-buffer))(startup-hook'(cvs-ediff-startup-hook)))(ediff-merge-buffers-with-ancestorb1b2basestartup-hook'ediff-merge-revisions-with-ancestorout)));;;; Interactive merge/diff support.;;(defuncvs-retrieve-revision(fileinforev)"Retrieve the given REVision of the file in FILEINFO into a new buffer."(let*((file(cvs-fileinfo->full-pathfileinfo))(buffile(concatfile"."rev)))(or(find-buffer-visitingbuffile)(with-current-buffer(create-file-bufferbuffile)(message"Retrieving revision %s..."rev);; Discard stderr output to work around the CVS+SSH+libc;; problem when stdout and stderr are the same.;; FIXME: this doesn't seem to make any difference :-((let((res(apply'call-processcvs-programnil'(t.nil)nil"-q""update""-p";; If `rev' is HEAD, don't pass it at all:;; the default behavior is to get the head;; of the current branch whereas "-r HEAD";; stupidly gives you the head of the trunk.(append(unless(equalrev"HEAD")(list"-r"rev))(listfile)))))(when(andres(not(and(equal0res))))(error"Something went wrong retrieving revision %s: %s"revres))(set-buffer-modified-pnil)(let((buffer-file-name(expand-file-namefile)))(after-find-file))(toggle-read-only1)(message"Retrieving revision %s... Done"rev)(current-buffer))))))(eval-and-compile(autoload'smerge-ediff"smerge-mode"));; FIXME: The user should be able to specify ancestor/head/backup and we should;; provide sensible defaults when merge info is unavailable (rather than rely;; on smerge-ediff). Also provide sane defaults for need-merge files.(defun-cvs-modecvs-mode-imerge()"Merge interactively appropriate revisions of the selected file."(interactive)(let((fi(cvs-mode-marked'mergenil:onet:filet)))(let((merge(cvs-fileinfo->mergefi))(file(cvs-fileinfo->full-pathfi))(backup-file(cvs-fileinfo->backup-filefi)))(if(not(andmergebackup-file))(let((buf(find-file-noselectfile)))(message"Missing merge info or backup file, using VC.")(with-current-bufferbuf(smerge-ediff)))(let*((ancestor-buf(cvs-retrieve-revisionfi(carmerge)))(head-buf(cvs-retrieve-revisionfi(cdrmerge)))(backup-buf(let((auto-mode-alistnil))(find-file-noselectbackup-file)));; this binding is used by cvs-ediff-startup-hook(cvs-transient-buffers(listancestor-bufbackup-bufhead-buf)))(with-current-bufferbackup-buf(let((buffer-file-name(expand-file-namefile)))(after-find-file)))(funcall(cdrcvs-idiff-imerge-handlers)backup-bufhead-bufancestor-buffile))))))(cvs-flags-definecvs-idiff-version(list"BASE"cvs-vendor-branchcvs-vendor-branch"BASE""BASE")"version: "cvs-qtypedesc-tag)(defun-cvs-mode(cvs-mode-idiff.NOARGS)(&optionalrev1rev2)"Diff interactively current file to revisions."(interactive(let*((rev1(cvs-prefix-get'cvs-branch-prefix))(rev2(andrev1(cvs-prefix-get'cvs-secondary-branch-prefix))))(list(orrev1(cvs-flags-query'cvs-idiff-version))rev2)))(let((fi(cvs-mode-marked'diff"idiff":onet:filet)))(let*((file(cvs-fileinfo->full-pathfi))(rev1-buf(cvs-retrieve-revisionfi(orrev1"BASE")))(rev2-buf(ifrev2(cvs-retrieve-revisionfirev2)));; this binding is used by cvs-ediff-startup-hook(cvs-transient-buffers(listrev1-bufrev2-buf)))(funcall(carcvs-idiff-imerge-handlers)rev1-buf(orrev2-buf(find-file-noselectfile))))))(defun-cvs-mode(cvs-mode-idiff-other.NOARGS)()"Diff interactively current file to revisions."(interactive)(let*((rev1(cvs-prefix-get'cvs-branch-prefix))(rev2(andrev1(cvs-prefix-get'cvs-secondary-branch-prefix)))(fis(cvs-mode-marked'diff"idiff":filet)))(when(>(lengthfis)2)(error"idiff-other cannot be applied to more than 2 files at a time"))(let*((fi1(carfis))(rev1-buf(ifrev1(cvs-retrieve-revisionfi1rev1)(find-file-noselect(cvs-fileinfo->full-pathfi1))))rev2-buf)(if(cdrfis)(let((fi2(nth1fis)))(setqrev2-buf(ifrev2(cvs-retrieve-revisionfi2rev2)(find-file-noselect(cvs-fileinfo->full-pathfi2)))))(error"idiff-other doesn't know what other file/buffer to use"))(let*(;; this binding is used by cvs-ediff-startup-hook(cvs-transient-buffers(listrev1-bufrev2-buf)))(funcall(carcvs-idiff-imerge-handlers)rev1-bufrev2-buf)))))(defuncvs-is-within-p(fisdir)"Non-nil is buffer is inside one of FIS (in DIR)."(when(stringpbuffer-file-name)(setqbuffer-file-name(expand-file-namebuffer-file-name))(let(ret)(dolist(fi(orfis(list(cvs-create-fileinfo'DIRCHANGE"""."""))))(when(cvs-string-prefix-p(expand-file-name(cvs-fileinfo->full-pathfi)dir)buffer-file-name)(setqrett)))ret)))(defun*cvs-mode-run(cmdflagsfis&key(buf(cvs-temp-buffer))dont-change-disccvsargspostproc)"Generic cvs-mode-<foo> function.Executes `cvs CVSARGS CMD FLAGS FIS'.BUF is the buffer to be used for cvs' output.DONT-CHANGE-DISC non-nil indicates that the command will not change the contents of files. This is only used by the parser.POSTPROC is a list of expressions to be evaluated at the very end (after parsing if applicable). It will be prepended with `progn' is necessary."(let((def-dirdefault-directory));; Save the relevant buffers(save-some-buffersnil(lambda()(cvs-is-within-pfisdef-dir))))(unless(listpflags)(error"flags should be a list of strings"));; Some w32 versions of CVS don't like an explicit . too much.(when(and(carfis)(null(cdrfis))(eq(cvs-fileinfo->type(carfis))'DIRCHANGE);; (equal (cvs-fileinfo->file (car fis)) ".")(equal(cvs-fileinfo->dir(carfis))""))(setqfisnil))(let*((single-dir(or(not(listpcvs-execute-single-dir))(membercmdcvs-execute-single-dir)))(parse(membercmdcvs-parse-known-commands))(args(appendcvsargs(listcmd)flags))(after-mode(nth2(cdr(assoccmdcvs-buffer-name-alist)))))(cvs-cleanup-collectioncvs-cookies;cleanup remaining messages(eqcvs-auto-remove-handled'delayed)nilt)(when(fboundpafter-mode)(setqpostproc(appendpostproc`((,after-mode)))))(whenparse(let((old-fis(when(membercmd'("status""update"));FIXME: Yuck!!;; absence of `cvs update' output has a specific meaning.(orfis(list(cvs-create-fileinfo'DIRCHANGE"""."""))))))(push`(cvs-parse-process',dont-change-discnil',old-fis)postproc)))(setqpostproc(if(cdrpostproc)(cons'prognpostproc)(carpostproc)))(cvs-update-headerargsfis)(with-current-bufferbuf(let((inhibit-read-onlyt))(erase-buffer))(message"Running cvs %s ..."cmd)(cvs-run-processargsfispostprocsingle-dir))))(defun*cvs-mode-do(cmdflagsfilter&keyshowdont-change-disccvsargspostproc)"Generic cvs-mode-<foo> function.Executes `cvs CVSARGS CMD FLAGS' on the selected files.FILTER is passed to `cvs-applicable-p' to only apply the command to files for which it makes sense.SHOW indicates that CMD should be not be run in the default temp buffer and should be shown to the user. The buffer and mode to be used is determined by `cvs-buffer-name-alist'.DONT-CHANGE-DISC non-nil indicates that the command will not change the contents of files. This is only used by the parser."(cvs-mode-runcmdflags(cvs-mode-markedfiltercmd):buf(cvs-temp-buffer(whenshowcmd)):dont-change-discdont-change-disc:cvsargscvsargs:postprocpostproc))(defun-cvs-mode(cvs-mode-status.SIMPLE)(flags)"Show cvs status for all marked files.With prefix argument, prompt for cvs flags."(interactive(list(cvs-flags-query'cvs-status-flags"cvs status flags")))(cvs-mode-do"status"flagsnil:dont-change-disct:showt:postproc(when(eqcvs-auto-remove-handled'status)'((with-current-buffer,(current-buffer)(cvs-mode-remove-handled))))))(defun-cvs-mode(cvs-mode-tree.SIMPLE)(flags)"Call cvstree using the file under the point as a keyfile."(interactive(list(cvs-flags-query'cvs-status-flags"cvs status flags")))(cvs-mode-run"status"(cons"-v"flags)(cvs-mode-markednil"status"):buf(cvs-temp-buffer"tree"):dont-change-disct:postproc'((cvs-status-cvstrees))));; cvs log(defun-cvs-mode(cvs-mode-log.NOARGS)(flags)"Display the cvs log of all selected files.With prefix argument, prompt for cvs flags."(interactive(list(cvs-add-branch-prefix(cvs-flags-query'cvs-log-flags"cvs log flags"))))(cvs-mode-do"log"flagsnil:showt))(defun-cvs-mode(cvs-mode-update.NOARGS)(flags)"Update all marked files.With a prefix argument, prompt for cvs flags."(interactive(list(cvs-add-branch-prefix(cvs-add-secondary-branch-prefix(cvs-flags-query'cvs-update-flags"cvs update flags")"-j")"-j")))(cvs-mode-do"update"flags'update))(defun-cvs-mode(cvs-mode-examine.NOARGS)(flags)"Re-examine all marked files.With a prefix argument, prompt for cvs flags."(interactive(list(cvs-add-branch-prefix(cvs-add-secondary-branch-prefix(cvs-flags-query'cvs-update-flags"cvs -n update flags")"-j")"-j")))(cvs-mode-do"update"flagsnil:cvsargs'("-n"):dont-change-disct))(defun-cvs-modecvs-mode-ignore(&optionalpattern)"Arrange so that CVS ignores the selected files.This command ignores files that are not flagged as `Unknown'."(interactive)(dolist(fi(cvs-mode-marked'ignore))(cvs-append-to-ignore(cvs-fileinfo->dirfi)(cvs-fileinfo->filefi)(eq(cvs-fileinfo->subtypefi)'NEW-DIR))(setf(cvs-fileinfo->typefi)'DEAD))(cvs-cleanup-collectioncvs-cookiesnilnilnil))(defuncvs-append-to-ignore(dirstr&optionalold-dir)"Add STR to the .cvsignore file in DIR.If OLD-DIR is non-nil, then this is a directory that we don't wantto hear about anymore."(with-current-buffer(find-file-noselect(expand-file-name".cvsignore"dir))(when(ignore-errors(andbuffer-read-only(eq'CVS(vc-backendbuffer-file-name))(not(vc-editable-pbuffer-file-name))));; CVSREAD=on special case(vc-checkoutbuffer-file-namet))(goto-char(point-max))(unless(bolp)(insert"\n"))(insertstr(ifold-dir"/\n""\n"))(ifcvs-sort-ignore-file(sort-linesnil(point-min)(point-max)))(save-buffer)))(defuncvs-mode-find-file-other-window(e)"Select a buffer containing the file in another window."(interactive(listlast-input-event))(cvs-mode-find-fileet))(defuncvs-mode-display-file(e)"Show a buffer containing the file in another window."(interactive(listlast-input-event))(cvs-mode-find-filee'dont-select))(defuncvs-find-modif(fi)(with-temp-buffer(call-processcvs-programnil(current-buffer)nil"-f""diff"(cvs-fileinfo->filefi))(goto-char(point-min))(if(re-search-forward"^\\([0-9]+\\)"nilt)(string-to-number(match-string1))1)))(defuncvs-mode-find-file(e&optionalother)"Select a buffer containing the file.With a prefix, opens the buffer in an OTHER window."(interactive(listlast-input-eventcurrent-prefix-arg));; If the event moves point, check that it moves it to a valid location.(when(and(/=(point)(progn(ignore-errors(mouse-set-pointe))(point)))(not(memq(get-text-property(1-(line-end-position))'font-lock-face)'(cvs-header-facecvs-filename-face))))(error"Not a file name"))(cvs-mode!(lambda(&optionalrev)(interactive(list(cvs-prefix-get'cvs-branch-prefix)))(let*((cvs-buf(current-buffer))(fi(cvs-mode-markednilnil:onet)))(if(eq(cvs-fileinfo->typefi)'DIRCHANGE)(let((odirdefault-directory))(setqdefault-directory(cvs-expand-dir-name(cvs-fileinfo->dirfi)))(cond((eqother'dont-select)(display-buffer(find-file-noselectdefault-directory)))(other(dired-other-windowdefault-directory))(t(direddefault-directory)))(set-buffercvs-buf)(setqdefault-directoryodir))(let((buf(ifrev(cvs-retrieve-revisionfirev)(find-file-noselect(cvs-fileinfo->full-pathfi)))))(funcall(cond((eqother'dont-select)'display-buffer)(other'switch-to-buffer-other-window)(t'switch-to-buffer))buf)(when(andcvs-find-file-and-jump(cvs-applicable-pfi'diff-base))(goto-line(cvs-find-modiffi)))buf))))))(defun-cvs-mode(cvs-mode-undo.SIMPLE)(flags)"Undo local changes to all marked files.The file is removed and `cvs update FILE' is run.";;"With prefix argument, prompt for cvs FLAGS."(interactive(listnil));; (cvs-flags-query 'cvs-undo-flags "undo flags")(ifcurrent-prefix-arg(call-interactively'cvs-mode-revert-to-rev)(let*((fis(cvs-do-removal'undo"update"'all))(removedp(lambda(fi)(or(eq(cvs-fileinfo->typefi)'REMOVED)(and(eq(cvs-fileinfo->typefi)'CONFLICT)(eq(cvs-fileinfo->subtypefi)'REMOVED)))))(fis-split(cvs-partitionremovedpfis))(fis-removed(carfis-split))(fis-other(cdrfis-split)))(if(nullfis-other)(whenfis-removed(cvs-mode-run"add"nilfis-removed))(cvs-mode-run"update"flagsfis-other:postproc(whenfis-removed`((with-current-buffer,(current-buffer)(cvs-mode-run"add"nil',fis-removed)))))))))(defun-cvs-mode(cvs-mode-revert-to-rev.NOARGS)(rev)"Revert the selected files to an old revision."(interactive(list(or(cvs-prefix-get'cvs-branch-prefix)(let((current-prefix-arg'(4)))(cvs-flags-query'cvs-idiff-version)))))(let*((fis(cvs-mode-marked'revert"revert":filet))(tag(concat"tmp_pcl_tag_"(make-temp-name"")))(untag`((with-current-buffer,(current-buffer)(cvs-mode-run"tag"(list"-d"',tag)',fis))))(update`((with-current-buffer,(current-buffer)(cvs-mode-run"update"(list"-j"',tag"-j"',rev)',fis:postproc',untag)))))(cvs-mode-run"tag"(listtag)fis:postprocupdate)))(defun-cvs-modecvs-mode-delete-lock()"Delete the lock file that CVS is waiting for.Note that this can be dangerous. You should only do thisif you are convinced that the process that created the lock is dead."(interactive)(let*((default-directory(cvs-expand-dir-namecvs-lock-file))(locks(directory-filesdefault-directorynilcvs-lock-file-regexp)))(cond((notlocks)(error"No lock files found"))((yes-or-no-p(concat"Really delete locks in "cvs-lock-file"? "))(dolist(locklocks)(cond((file-directory-plock)(delete-directorylock))((file-exists-plock)(delete-filelock))))))))(defun-cvs-modecvs-mode-remove-handled()"Remove all lines that are handled.Empty directories are removed."(interactive)(cvs-cleanup-collectioncvs-cookiest(orcvs-auto-remove-directories'handled)t))(defun-cvs-modecvs-mode-acknowledge()"Remove all marked files from the buffer."(interactive)(dolist(fi(cvs-get-marked(cvs-ignore-marks-p"acknowledge")t))(setf(cvs-fileinfo->typefi)'DEAD))(cvs-cleanup-collectioncvs-cookiesnilnilnil))(defuncvs-do-removal(filter&optionalcmdall)"Remove files.Returns a list of FIS that should be `cvs remove'd."(let*((files(cvs-mode-markedfiltercmd:filet:read-onlyt))(fis(cdr(cvs-partition(lambda(fi)(eq(cvs-fileinfo->typefi)'UNKNOWN))(cvs-mode-markedfiltercmd))))(silent(or(notcvs-confirm-removals)(cvs-every(lambda(fi)(or(not(file-exists-p(cvs-fileinfo->full-pathfi)))(cvs-applicable-pfi'safe-rm)))files)))(tmpbuf(cvs-temp-buffer)))(when(and(notsilent)(equalcvs-confirm-removals'list))(with-current-buffertmpbuf(let((inhibit-read-onlyt))(cvs-insert-strings(mapcar'cvs-fileinfo->full-pathfis))(cvs-pop-to-buffer-same-frame(current-buffer))(shrink-window-if-larger-than-buffer))))(if(not(orsilent(unwind-protect(yes-or-no-p(format"Delete %d files? "(lengthfiles)))(cvs-bury-buffertmpbufcvs-buffer))))(progn(message"Aborting")nil)(dolist(fifiles)(let*((type(cvs-fileinfo->typefi))(file(cvs-fileinfo->full-pathfi)))(when(orall(eqtype'UNKNOWN))(when(file-exists-pfile)(delete-filefile))(unlessall(setf(cvs-fileinfo->typefi)'DEAD)t))))fis)))(defun-cvs-mode(cvs-mode-remove.SIMPLE)(flags)"Remove all marked files.With prefix argument, prompt for cvs flags."(interactive(list(cvs-flags-query'cvs-remove-flags"cvs remove flags")))(let((fis(cvs-do-removal'remove)))(iffis(cvs-mode-run"remove"(cons"-f"flags)fis)(cvs-cleanup-collectioncvs-cookiesnilnilnil))))(defvarcvs-tag-name"")(defun-cvs-mode(cvs-mode-tag.SIMPLE)(tag&optionalflags)"Run `cvs tag TAG' on all selected files.With prefix argument, prompt for cvs flags.By default this can only be used on directories.Use \\[cvs-mode-force-command] or change `cvs-force-dir-tag' if you needto use it on individual files."(interactive(list(setqcvs-tag-name(cvs-query-readcvs-tag-name"Tag name: "cvs-qtypedesc-tag))(cvs-flags-query'cvs-tag-flags"tag flags")))(cvs-mode-do"tag"(appendflags(listtag))(whencvs-force-dir-tag'tag)))(defun-cvs-mode(cvs-mode-untag.SIMPLE)(tag&optionalflags)"Run `cvs tag -d TAG' on all selected files.With prefix argument, prompt for cvs flags."(interactive(list(setqcvs-tag-name(cvs-query-readcvs-tag-name"Tag to delete: "cvs-qtypedesc-tag))(cvs-flags-query'cvs-tag-flags"tag flags")))(cvs-mode-do"tag"(append'("-d")flags(listtag))(whencvs-force-dir-tag'tag)));; Byte compile files.(defun-cvs-modecvs-mode-byte-compile-files()"Run byte-compile-file on all selected files that end in '.el'."(interactive)(let((marked(cvs-get-marked(cvs-ignore-marks-p"byte-compile"))))(dolist(fimarked)(let((filename(cvs-fileinfo->full-pathfi)))(when(string-match"\\.el\\'"filename)(byte-compile-filefilename))))));; ChangeLog support.(defun-cvs-modecvs-mode-add-change-log-entry-other-window()"Add a ChangeLog entry in the ChangeLog of the current directory."(interactive)(dolist(fi(cvs-mode-markednilnil))(let((default-directory(cvs-expand-dir-name(cvs-fileinfo->dirfi)))(buffer-file-name(expand-file-name(cvs-fileinfo->filefi))))(kill-local-variable'change-log-default-name)(save-excursion(add-change-log-entry-other-window)))));; interactive commands to set optional flags(defuncvs-mode-set-flags(flag)"Ask for new setting of cvs-FLAG-flags."(interactive(list(completing-read"Which flag: "'("cvs""diff""update""status""log""tag";"rtag""commit""remove""undo""checkout")nilt)))(let*((sym(intern(concat"cvs-"flag"-flags"))))(let((current-prefix-arg'(16)))(cvs-flags-querysym(concatflag" flags")))));;;;;;;; Utilities for the *cvs* buffer;;;;(defuncvs-dir-member-p(fileinfodir)"Return true if FILEINFO represents a file in directory DIR."(and(not(eq(cvs-fileinfo->typefileinfo)'DIRCHANGE))(cvs-string-prefix-pdir(cvs-fileinfo->dirfileinfo))))(defuncvs-execute-single-file(fiextractorprogramconstant-args)"Internal function for `cvs-execute-single-file-list'."(let*((arg-list(funcallextractorfi))(inhibit-read-onlyt));; Execute the command unless extractor returned t.(when(listparg-list)(let*((args(appendconstant-argsarg-list)))(insert(format"=== %s %s\n\n"program(cvs-strings->stringargs)));; FIXME: return the exit status?(apply'call-processprogramnilttargs)(goto-char(point-max))))));; FIXME: make this run in the background ala cvs-run-process...(defuncvs-execute-single-file-list(fisextractorprogramconstant-args)"Run PROGRAM on all elements on FIS.CONSTANT-ARGS is a list of strings to pass as arguments to PROGRAM.The arguments given to the program will be CONSTANT-ARGS followed bythe list that EXTRACTOR returns.EXTRACTOR will be called once for each file on FIS. It is givenone argument, the cvs-fileinfo. It can return t, which means ignorethis file, or a list of arguments to send to the program."(dolist(fifis)(cvs-execute-single-filefiextractorprogramconstant-args)))(defuncvs-revert-if-needed(fis)(dolist(fileinfofis)(let*((file(cvs-fileinfo->full-pathfileinfo))(buffer(find-buffer-visitingfile)));; For a revert to happen the user must be editing the file...(unless(or(nullbuffer)(eq(cvs-fileinfo->typefileinfo)'MESSAGE);; FIXME: check whether revert is really needed.;; `(verify-visited-file-modtime buffer)' doesn't cut it;; because it only looks at the time stamp (it ignores;; read-write changes) which is not changed by `commit'.(buffer-modified-pbuffer))(with-current-bufferbuffer(ignore-errors(revert-buffer'ignore-auto'dont-ask'preserve-modes);; `preserve-modes' avoids changing the (minor) modes. But we;; do want to reset the mode for VC, so we do it explicitly.(vc-find-file-hook)(when(eq(cvs-fileinfo->typefileinfo)'CONFLICT)(smerge-mode1))))))))(defuncvs-change-cvsroot(newroot)"Change the cvsroot."(interactive"DNew repository: ")(if(or(file-directory-p(expand-file-name"CVSROOT"newroot))(y-or-n-p(concat"Warning: no CVSROOT found inside repository."" Change cvs-cvsroot anyhow?")))(setqcvs-cvsrootnewroot)));;;;;;;; useful global settings;;;;;;;###autoload(add-to-list'completion-ignored-extensions"CVS/");;;; Hook to allow calling PCL-CVS by visiting the /CVS subdirectory;;;;;###autoload(defcustomcvs-dired-action'cvs-quickdir"The action to be performed when opening a CVS directory.Sensible values are `cvs-examine', `cvs-status' and `cvs-quickdir'.":group'pcl-cvs:type'(choice(constcvs-examine)(constcvs-status)(constcvs-quickdir)));;;###autoload(defcustomcvs-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))));;;###autoload(progn(defuncvs-dired-noselect(dir)"Run `cvs-examine' if DIR is a CVS administrative directory.The exact behavior is determined also by `cvs-dired-use-hook'."(when(stringpdir)(setqdir(directory-file-namedir))(when(and(string="CVS"(file-name-nondirectorydir))(file-readable-p(expand-file-name"Entries"dir))cvs-dired-use-hook(if(eqcvs-dired-use-hook'always)(notcurrent-prefix-arg)(equalcurrent-prefix-argcvs-dired-use-hook)))(save-excursion(funcallcvs-dired-action(file-name-directorydir)tt))))));;;; hook into VC;;(add-hook'vc-post-command-functions'cvs-vc-command-advice)(defuncvs-vc-command-advice(commandfileflags)(when(and(equalcommand"cvs")(progn(while(and(stringp(carflags))(string-match"\\`-"(carflags)))(popflags));; don't parse output we don't understand.(member(carflags)cvs-parse-known-commands));; Don't parse "update -p" output.(not(and(member(carflags)'("update""checkout"))(let((found-pnil))(dolist(flagflagsfound-p)(if(equalflag"-p")(setqfound-pt)))))))(save-current-buffer(let((buffer(current-buffer))(dirdefault-directory)(cvs-from-vct))(dolist(cvs-buf(buffer-list))(set-buffercvs-buf);; look for a corresponding pcl-cvs buffer(when(and(eqmajor-mode'cvs-mode)(cvs-string-prefix-pdefault-directorydir))(let((subdir(substringdir(lengthdefault-directory))))(set-bufferbuffer)(set(make-local-variable'cvs-buffer)cvs-buf);; `cvs -q add file' produces no useful output :-((when(and(equal(carflags)"add")(goto-char(point-min))(looking-at".*to add this file permanently\n\\'"))(insert"cvs add: scheduling file `"(file-name-nondirectoryfile)"' for addition\n"));; VC never (?) does `cvs -n update' so dcd=nil;; should probably always be the right choice.(cvs-parse-processnilsubdir))))))));;;; Hook into write-buffer;;(defuncvs-mark-buffer-changed()(let*((file(expand-file-namebuffer-file-name))(version(and(fboundp'vc-backend)(eq(vc-backendfile)'CVS)(vc-workfile-versionfile))))(whenversion(save-excursion(dolist(cvs-buf(buffer-list))(set-buffercvs-buf);; look for a corresponding pcl-cvs buffer(when(and(eqmajor-mode'cvs-mode)(cvs-string-prefix-pdefault-directoryfile))(let*((file(substringfile(lengthdefault-directory)))(fi(cvs-create-fileinfo(if(string="0"version)'ADDED'MODIFIED)(or(file-name-directoryfile)"")(file-name-nondirectoryfile)"cvs-mark-buffer-changed")))(cvs-addto-collectioncvs-cookiesfi))))))))(add-hook'after-save-hook'cvs-mark-buffer-changed)(provide'pcvs);;; pcvs.el ends here