diff options
Diffstat (limited to 'gnu/usr.bin/cvs/contrib/pcl-cvs/pcl-cvs.el')
| -rw-r--r-- | gnu/usr.bin/cvs/contrib/pcl-cvs/pcl-cvs.el | 1820 |
1 files changed, 1275 insertions, 545 deletions
diff --git a/gnu/usr.bin/cvs/contrib/pcl-cvs/pcl-cvs.el b/gnu/usr.bin/cvs/contrib/pcl-cvs/pcl-cvs.el index 99da369..9bbbd38 100644 --- a/gnu/usr.bin/cvs/contrib/pcl-cvs/pcl-cvs.el +++ b/gnu/usr.bin/cvs/contrib/pcl-cvs/pcl-cvs.el @@ -1,6 +1,6 @@ -;;; pcl-cvs.el,v 1.2 1992/04/07 20:49:19 berliner Exp -;;; pcl-cvs.el -- A Front-end to CVS 1.3 or later. Release 1.02. -;;; Copyright (C) 1991, 1992 Per Cederqvist +;;; @(#) Id: pcl-cvs.el,v 1.93 1993/05/31 22:44:00 ceder Exp +;;; pcl-cvs.el -- A Front-end to CVS 1.3 or later. Release 1.05. +;;; Copyright (C) 1991, 1992, 1993 Per Cederqvist ;;; ;;; 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 @@ -22,8 +22,12 @@ ;;;; General Public License is included in that file. You should read ;;;; it to get the most from this package. +;;;; Send bug reports and improvements to ceder@lysator.liu.se or +;;;; ceder@signum.se. Talk some about Signum Support here. +++FIXME + ;;; Don't try to use this with CVS 1.2 or earlier. It won't work. Get -;;; CVS 1.3. +;;; CVS 1.3. This package works together with RCS 5.6 and probably 5.5 +;;; as well. ;;; Mail questions and bug reports to ceder@lysator.liu.se. @@ -39,8 +43,8 @@ (defvar cvs-diff-program "/usr/gnu/bin/diff" "*Full path to the diff program.") -(defvar cvs-rm-program "/usr/gnu/bin/rm" - "*Full path to the rm program. Typically /bin/rm.") +(defvar cvs-rmdir-program "/usr/gnu/bin/rmdir" + "*Full path to the rmdir program. Typically /bin/rmdir.") ;; Uncomment the following line if you are running on 18.57 or earlier. ;(setq delete-exited-processes nil) @@ -49,9 +53,24 @@ ;; memory, and 18.57 forgets to GCPROT a variable if ;; delete-exited-processes is t. +(defvar cvs-shell "/bin/sh" + "*Full path to a shell that can do redirection on stdout.") + ;;; END OF THINGS TO CHECK WHEN INSTALLING ;;; -------------------------------------------------------- +(defvar cvs-cvsroot nil + "*Specifies where the (current) cvs master repository is. +Overrides the $CVSROOT variable by sending \" -d dir\" to all cvs commands. +This switch is useful if you have multiple CVS repositories.") + +(defvar cvs-stdout-file nil + "Name of the file that holds the output that CVS sends to stdout. +This variable is buffer local.") + +(defvar cvs-lock-file nil + "Full path to a lock file that CVS is waiting for (or was waiting for).") + (defvar cvs-bakprefix ".#" "The prefix that CVS prepends to files when rcsmerge'ing.") @@ -59,11 +78,17 @@ "*Non-nil if input buffers should be cleared before asking for new info.") (defvar cvs-auto-remove-handled nil - "*Non-nil if cvs-remove-handled should be called automatically. + "*Non-nil if cvs-mode-remove-handled should be called automatically. If this is set to any non-nil value entries that does not need to be -checked in will be removed from the *cvs* buffer after every cvs-commit +checked in will be removed from the *cvs* buffer after every cvs-mode-commit command.") +(defvar cvs-sort-ignore-file t + "*Non-nil if cvs-mode-ignore should sort the .cvsignore automatically.") + +(defvar cvs-auto-revert-after-commit t + "*Non-nil if committed buffers should be automatically reverted.") + (defconst cvs-cursor-column 14 "Column to position cursor in in cvs-mode. Column 0 is left-most column.") @@ -81,14 +106,21 @@ Column 0 is left-most column.") "Name of buffer in which the user is prompted for a log message when committing files.") +(defvar cvs-commit-buffer-require-final-newline t + "*t says silently put a newline at the end of commit log messages. +Non-nil but not t says ask user whether to add a newline in each such case. +nil means don't add newlines.") + (defvar cvs-temp-buffer-name "*cvs-tmp*" "*Name of the cvs temporary buffer. Output from cvs is placed here by synchronous commands.") -(defvar cvs-cvs-diff-flags nil - "*List of strings to use as flags to pass to ``cvs diff''. -Used by cvs-diff-cvs. -Set this to '("-u") to get a Unidiff format, or '("-c") to get context diffs.") +(defvar cvs-diff-ignore-marks nil + "*Non-nil if cvs-diff and cvs-mode-diff-backup should ignore any marked files. +Normally they run diff on the files that are marked (with cvs-mode-mark), +or the file under the cursor if no files are marked. If this variable +is set to a non-nil value they will always run diff on the file on the +current line.") (defvar cvs-status-flags nil "*List of strings to pass to ``cvs status''.") @@ -97,8 +129,21 @@ Set this to '("-u") to get a Unidiff format, or '("-c") to get context diffs.") "*List of strings to pass to ``cvs log''.") (defvar cvs-diff-flags nil - "*List of strings to use as flags to pass to ``diff''. -Do not confuse with cvs-cvs-diff-flags. Used by cvs-diff-backup.") + "*List of strings to use as flags to pass to ``diff'' and ``cvs diff''. +Used by cvs-mode-diff-cvs and cvs-mode-diff-backup. +Set this to '(\"-u\") to get a Unidiff format, or '(\"-c\") to get context diffs.") + +(defvar cvs-update-prog-output-skip-regexp "$" + "*A regexp that matches the end of the output from all cvs update programs. +That is, output from any programs that are run by CVS (by the flag -u +in the `modules' file - see cvs(5)) when `cvs update' is performed should +terminate with a line that this regexp matches. It is enough that +some part of the line is matched. + +The default (a single $) fits programs without output.") + +;; The variables below are used internally by pcl-cvs. You should +;; never change them. (defvar cvs-buffers-to-delete nil "List of temporary buffers that should be discarded as soon as possible. @@ -110,21 +155,29 @@ Due to a bug in emacs 18.57 the sentinel can't discard them reliably.") ;; to their .emacs they can get rid of it. Just don't add that line ;; to your default.el! (defvar cvs-inhibit-copyright-message nil - "*Don't display a Copyright message in the ``*cvs*'' buffer.") + "*Non-nil means don't display a Copyright message in the ``*cvs*'' buffer.") -(defvar cvs-startup-message +(defconst pcl-cvs-version "1.05" + "A string denoting the current release version of pcl-cvs.") + +(defconst cvs-startup-message (if cvs-inhibit-copyright-message - "PCL-CVS release 1.02" - "PCL-CVS release 1.02. Copyright (C) 1992 Per Cederqvist + "PCL-CVS release 1.05" + "PCL-CVS release 1.05. Copyright (C) 1992, 1993 Per Cederqvist Pcl-cvs comes with absolutely no warranty; for details consult the manual. This is free software, and you are welcome to redistribute it under certain conditions; again, consult the TeXinfo manual for details.") "*Startup message for CVS.") -(defvar cvs-cvs-buffer nil - "Internal to pcl-cvs.el. -This variable exists in the *cvs-commit-message* buffer and names -the *cvs* buffer.") +(defvar cvs-update-running nil + "This is set to nil when no process is running, and to +the process when a cvs update process is running.") + +(defvar cvs-cookie-handle nil + "Handle for the cookie structure that is displayed in the *cvs* buffer.") + +(defvar cvs-mode-commit nil + "Used internally by pcl-cvs.") ;;; The cvs data structure: ;;; @@ -148,15 +201,20 @@ the *cvs* buffer.") ;;; CONFLICT - conflict when merging ;;; REM-CONFLICT-removed in repository, changed locally. ;;; MOD-CONFLICT-removed locally, changed in repository. +;;; REM-EXIST -removed locally, but still exists. ;;; DIRCHANGE - A change of directory. ;;; UNKNOWN - An unknown file. ;;; MOVE-AWAY - A file that is in the way. ;;; REPOS-MISSING- The directory is removed from the ;;; repository. Go fetch a backup. +;;; MESSAGE - This is a special fileinfo that is used +;;; to display a text that should be in +;;; full-log. ;;; dir Directory the file resides in. Should not end with ;;; slash. ;;; file-name The file name. -;;; backup-file Name of the backup file if MERGED or CONFLICT. +;;; base-revision The revision that the working file was based on. +;;; Onlyy valid for MERGED and CONFLICT files. ;;; cvs-diff-buffer A buffer that contains a 'cvs diff file'. ;;; backup-diff-buffer A buffer that contains a 'diff file backup-file'. ;;; full-log The output from cvs, unparsed. @@ -191,11 +249,15 @@ A fileinfo has the following fields: REM-CONFLICT-removed in repository, but altered locally. MOD-CONFLICT-removed locally, changed in repository. + REM-EXIST - removed locally, but still exists. DIRCHANGE - A change of directory. UNKNOWN - An unknown file. MOVE-AWAY - A file that is in the way. REPOS-MISSING- The directory has vanished from the repository. + MESSAGE - This is a special fileinfo that is used + to display a text that should be in + full-log. dir Directory the file resides in. Should not end with slash. file-name The file name. backup-file Name of the backup file if MERGED or CONFLICT. @@ -222,8 +284,8 @@ A fileinfo has the following fields: (defun cvs-fileinfo->type (cvs-fileinfo) "Get type from CVS-FILEINFO. Type is one of UPDATED, MODIFIED, ADDED, REMOVED, CVS-REMOVED, MERGED, -CONFLICT, REM-CONFLICT, MOD-CONFLICT, DIRCHANGE, UNKNOWN, MOVE-AWAY -or REPOS-MISSING." +CONFLICT, REM-CONFLICT, MOD-CONFLICT, REM-EXIST, DIRCHANGE, UNKNOWN, MOVE-AWAY, +REPOS-MISSING or MESSAGE." (elt (cdr cvs-fileinfo) 2)) (defun cvs-fileinfo->dir (cvs-fileinfo) @@ -235,8 +297,8 @@ The directory name does not end with a slash. " "Get file-name from CVS-FILEINFO." (elt (cdr cvs-fileinfo) 4)) -(defun cvs-fileinfo->backup-file (cvs-fileinfo) - "Get backup-file from CVS-FILEINFO." +(defun cvs-fileinfo->base-revision (cvs-fileinfo) + "Get the base revision from CVS-FILEINFO." (elt (cdr cvs-fileinfo) 5)) (defun cvs-fileinfo->cvs-diff-buffer (cvs-fileinfo) @@ -278,8 +340,8 @@ The directory should now end with a slash." "Set file-name in CVS-FILEINFO to NEWVAL." (aset (cdr cvs-fileinfo) 4 newval)) -(defun cvs-set-fileinfo->backup-file (cvs-fileinfo newval) - "Set backup-file in CVS-FILEINFO to NEWVAL." +(defun cvs-set-fileinfo->base-revision (cvs-fileinfo newval) + "Set base-revision in CVS-FILEINFO to NEWVAL." (aset (cdr cvs-fileinfo) 5 newval)) (defun cvs-set-fileinfo->cvs-diff-buffer (cvs-fileinfo newval) @@ -313,10 +375,12 @@ The directory should now end with a slash." The selected window will not be changed. The temporary buffer will be erased and writable." - (display-buffer (get-buffer-create cvs-temp-buffer-name)) - (set-buffer cvs-temp-buffer-name) - (setq buffer-read-only nil) - (erase-buffer)) + (let ((dir default-directory)) + (display-buffer (get-buffer-create cvs-temp-buffer-name)) + (set-buffer cvs-temp-buffer-name) + (setq buffer-read-only nil) + (setq default-directory dir) + (erase-buffer))) ; Too complicated to handle all the cases that are generated. ; Maybe later. @@ -337,7 +401,20 @@ If optional prefix argument LOCAL is non-nil, 'cvs update -l' is run." (interactive (list (read-file-name "CVS Update (directory): " nil default-directory nil) current-prefix-arg)) - (cvs-do-update directory local nil)) + (cvs-do-update directory local nil) + (switch-to-buffer cvs-buffer-name)) + +(defun cvs-update-other-window (directory &optional local) + "Run a 'cvs update' in the current working directory. Feed the +output to a *cvs* buffer, display it in the other window, and run +cvs-mode on it. + +If optional prefix argument LOCAL is non-nil, 'cvs update -l' is run." + (interactive (list (read-file-name "CVS Update other window (directory): " + nil default-directory nil) + current-prefix-arg)) + (cvs-do-update directory local nil) + (switch-to-buffer-other-window cvs-buffer-name)) (defun cvs-filter (predicate list &rest extra-args) "Apply PREDICATE to each element on LIST. @@ -356,58 +433,109 @@ passed to PREDICATE." (setq list (cdr list))) (cdr head))) -(defun cvs-update-no-prompt () +(defun cvs-mode-update-no-prompt () "Run cvs update in current directory." (interactive) (cvs-do-update default-directory nil nil)) (defun cvs-do-update (directory local dont-change-disc) "Do a 'cvs update' in DIRECTORY. +Args: DIRECTORY LOCAL DONT-CHANGE-DISC &optional NOTTHISWINDOW. If LOCAL is non-nil 'cvs update -l' is executed. If DONT-CHANGE-DISC is non-nil 'cvs -n update' is executed. Both LOCAL and DONT-CHANGE-DISC may be non-nil simultaneously. *Note*: DONT-CHANGE-DISC does not yet work. The parser gets confused." (save-some-buffers) + (if (not (file-exists-p cvs-program)) + (error "%s: file not found (check setting of cvs-program)" + cvs-program)) + (if (not (or (getenv "CVSROOT") cvs-cvsroot)) + (error "Both cvs-cvsroot and environment variable CVSROOT unset.")) (let* ((this-dir (file-name-as-directory (expand-file-name directory))) - (use-this-window (equal (buffer-name (current-buffer)) - cvs-buffer-name)) (update-buffer (generate-new-buffer (concat (file-name-nondirectory (substring this-dir 0 -1)) "-update"))) - cvs-process args) - - ;; The *cvs* buffer is killed to avoid confusion - is the update ready - ;; or not? - (if (get-buffer cvs-buffer-name) - (kill-buffer cvs-buffer-name)) - - ;; Generate "-n update -l". - (if local (setq args (list "-l"))) - (setq args (cons "update" args)) - (if dont-change-disc (setq args (cons "-n" args))) - - ;; Set up the buffer that receives the output from "cvs update". - (if use-this-window - (switch-to-buffer update-buffer) - (set-buffer update-buffer) - (display-buffer update-buffer)) - + (temp-name (make-temp-name + (concat (file-name-as-directory + (or (getenv "TMPDIR") "/tmp")) + "pcl-cvs."))) + (args nil)) + + ;; Check that this-dir exists and is a directory that is under CVS contr. + + (if (not (file-directory-p this-dir)) + (error "%s is not a directory." this-dir)) + (if (not (file-directory-p (concat this-dir "CVS"))) + (error "%s does not contain CVS controlled files." this-dir)) + + ;; Check that at most one `cvs update' is run at any time. + + (if (and cvs-update-running (process-status cvs-update-running) + (or (eq (process-status cvs-update-running) 'run) + (eq (process-status cvs-update-running) 'stop))) + (error "Can't run two `cvs update' simultaneously.")) + + ;; Generate "-d /master -n update -l". + (setq args (concat (if cvs-cvsroot (concat " -d " cvs-cvsroot)) + (if dont-change-disc " -n ") + " update " + (if local " -l "))) + + ;; Set up the buffer that receives the stderr output from "cvs update". + (set-buffer update-buffer) (setq default-directory this-dir) - (setq cvs-process + (make-local-variable 'cvs-stdout-file) + (setq cvs-stdout-file temp-name) + + (setq cvs-update-running (let ((process-connection-type nil)) ; Use a pipe, not a pty. - (apply 'start-process "cvs" update-buffer cvs-program args))) + (start-process "cvs" update-buffer cvs-shell "-c" + (concat cvs-program " " args " > " temp-name)))) (setq mode-line-process (concat ": " - (symbol-name (process-status cvs-process)))) + (symbol-name (process-status cvs-update-running)))) (set-buffer-modified-p (buffer-modified-p)) ; Update the mode line. - (set-process-sentinel cvs-process 'cvs-sentinel) + (set-process-sentinel cvs-update-running 'cvs-sentinel) + (set-process-filter cvs-update-running 'cvs-update-filter) + (set-marker (process-mark cvs-update-running) (point-min)) + + (save-excursion + (set-buffer (get-buffer-create cvs-buffer-name)) + (setq buffer-read-only nil) + (erase-buffer) + (cvs-mode)) + + (setq cvs-cookie-handle + (collection-create + cvs-buffer-name 'cvs-pp + cvs-startup-message ;Se comment above cvs-startup-message. + "---------- End -----")) + + (cookie-enter-first + cvs-cookie-handle + (cvs-create-fileinfo + 'MESSAGE nil nil (concat "\n Running `cvs " args "' in " this-dir + "...\n"))) + + (save-excursion + (set-buffer cvs-buffer-name) + (setq mode-line-process + (concat ": " + (symbol-name (process-status cvs-update-running)))) + (set-buffer-modified-p (buffer-modified-p)) ; Update the mode line. + (setq buffer-read-only t)) ;; Work around a bug in emacs 18.57 and earlier. (setq cvs-buffers-to-delete - (cvs-delete-unused-temporary-buffers cvs-buffers-to-delete)))) + (cvs-delete-unused-temporary-buffers cvs-buffers-to-delete))) + + ;; The following line is said to improve display updates on some + ;; emacses. It shouldn't be needed, but it does no harm. + (sit-for 0)) + (defun cvs-delete-unused-temporary-buffers (list) "Delete all buffers on LIST that is not visible. @@ -430,27 +558,30 @@ Return a list of all buffers that still is alive." To get the *cvs* buffer you should use ``\\[cvs-update]''. -Full documentation is in the TeXinfo file. These are the most useful commands: - -\\[cookie-previous-cookie] Move up. \\[cookie-next-cookie] Move down. -\\[cvs-commit] Commit file. \\[cvs-update-no-prompt] Reupdate directory. -\\[cvs-mark] Mark file/dir. \\[cvs-unmark] Unmark file/dir. -\\[cvs-mark-all-files] Mark all files. \\[cvs-unmark-all-files] Unmark all files. -\\[cvs-find-file] Edit file/run Dired. \\[cvs-find-file-other-window] Find file or run Dired in other window. -\\[cvs-remove-handled] Remove processed entries. \\[cvs-add-change-log-entry-other-window] Write ChangeLog in other window. -\\[cvs-add] Add to repository. \\[cvs-remove-file] Remove file. -\\[cvs-diff-cvs] Diff between base revision. \\[cvs-diff-backup] Diff backup file. -\\[cvs-acknowledge] Delete line from buffer. \\[cvs-ignore] Add file to the .cvsignore file. -\\[cvs-log] Run ``cvs log''. \\[cvs-status] Run ``cvs status''. +Full documentation is in the Texinfo file. These are the most useful commands: + +\\[cvs-mode-previous-line] Move up. \\[cvs-mode-next-line] Move down. +\\[cvs-mode-commit] Commit file. \\[cvs-mode-update-no-prompt] Reupdate directory. +\\[cvs-mode-mark] Mark file/dir. \\[cvs-mode-unmark] Unmark file/dir. +\\[cvs-mode-mark-all-files] Mark all files. \\[cvs-mode-unmark-all-files] Unmark all files. +\\[cvs-mode-find-file] Edit file/run Dired. \\[cvs-mode-find-file-other-window] Find file or run Dired in other window. +\\[cvs-mode-remove-handled] Remove processed entries. \\[cvs-mode-add-change-log-entry-other-window] Write ChangeLog in other window. +\\[cvs-mode-add] Add to repository. \\[cvs-mode-remove-file] Remove file. +\\[cvs-mode-diff-cvs] Diff between base revision. \\[cvs-mode-diff-backup] Diff backup file. +\\[cvs-mode-emerge] Run emerge on base revision/backup file. +\\[cvs-mode-acknowledge] Delete line from buffer. \\[cvs-mode-ignore] Add file to the .cvsignore file. +\\[cvs-mode-log] Run ``cvs log''. \\[cvs-mode-status] Run ``cvs status''. +\\[cvs-mode-undo-local-changes] Revert the last checked in version - discard your changes to the file. Entry to this mode runs cvs-mode-hook. -This description is updated for release 1.02 of pcl-cvs. +This description is updated for release 1.05 of pcl-cvs. + All bindings: \\{cvs-mode-map}" (interactive) (setq major-mode 'cvs-mode) (setq mode-name "CVS") - (setq buffer-read-only nil) + (setq mode-line-process nil) (buffer-flush-undo (current-buffer)) (make-local-variable 'goal-column) (setq goal-column cvs-cursor-column) @@ -477,10 +608,16 @@ it is finished." (setq mode-line-process (concat ": " (symbol-name (process-status proc)))) - (cvs-parse-buffer) - (setq cvs-buffers-to-delete - (cons (process-buffer proc) cvs-buffers-to-delete))) - (set-buffer-modified-p (buffer-modified-p))) + (let* ((out-file cvs-stdout-file) + (stdout-buffer (find-file-noselect out-file))) + (cvs-parse-update stdout-buffer (process-buffer proc)) + (setq cvs-buffers-to-delete + (cons (process-buffer proc) + (cons stdout-buffer + cvs-buffers-to-delete))) + (delete-file out-file))) + (set-buffer-modified-p (buffer-modified-p)) + (setq cvs-update-running nil)) (if (equal obuf (process-buffer proc)) nil (set-buffer (process-buffer proc)) @@ -488,9 +625,90 @@ it is finished." (goto-char opoint)) (set-buffer obuf)))))) -(defun cvs-skip-line (regexp errormsg &optional arg) +(defun cvs-update-filter (proc string) + "Filter function for pcl-cvs. +This function gets the output that CVS sends to stderr. It inserts it +into (process-buffer proc) but it also checks if CVS is waiting for a +lock file. If so, it inserts a message cookie in the *cvs* buffer." + (let ((old-buffer (current-buffer)) + (data (match-data))) + (unwind-protect + (progn + (set-buffer (process-buffer proc)) + (save-excursion + ;; Insert the text, moving the process-marker. + (goto-char (process-mark proc)) + (insert string) + (set-marker (process-mark proc) (point)) + ;; Delete any old lock message + (if (tin-nth cvs-cookie-handle 1) + (tin-delete cvs-cookie-handle + (tin-nth cvs-cookie-handle 1))) + ;; Check if CVS is waiting for a lock. + (beginning-of-line 0) ;Move to beginning of last + ;complete line. + (cond + ((looking-at + "^cvs update: \\[..:..:..\\] waiting \ +for \\(.*\\)lock in \\(.*\\)$") + (setq cvs-lock-file (buffer-substring (match-beginning 2) + (match-end 2))) + (cookie-enter-last + cvs-cookie-handle + (cvs-create-fileinfo + 'MESSAGE nil nil + (concat "\tWaiting for " + (buffer-substring (match-beginning 1) + (match-end 1)) + "lock in " cvs-lock-file + ".\n\t (type M-x cvs-delete-lock to delete it)"))))))) + (store-match-data data) + (set-buffer old-buffer)))) + +(defun cvs-delete-lock () + "Delete the lock file that CVS is waiting for. +Note that this can be dangerous. You should only do this +if you are convinced that the process that created the lock is dead." + (interactive) + (cond + ((not (or (file-exists-p + (concat (file-name-as-directory cvs-lock-file) "#cvs.lock")) + (cvs-filter (function cvs-lock-file-p) + (directory-files cvs-lock-file)))) + (error "No lock files found.")) + ((yes-or-no-p (concat "Really delete locks in " cvs-lock-file "? ")) + ;; Re-read the directory -- the locks might have disappeared. + (let ((locks (cvs-filter (function cvs-lock-file-p) + (directory-files cvs-lock-file)))) + (while locks + (delete-file (concat (file-name-as-directory cvs-lock-file) + (car locks))) + (setq locks (cdr locks))) + (cvs-remove-directory + (concat (file-name-as-directory cvs-lock-file) "#cvs.lock")))))) + +(defun cvs-remove-directory (dir) + "Remove a directory." + (if (file-directory-p dir) + (call-process cvs-rmdir-program nil nil nil dir) + (error "Not a directory: %s" dir)) + (if (file-exists-p dir) + (error "Could not remove directory %s" dir))) + +(defun cvs-lock-file-p (file) + "Return true if FILE looks like a CVS lock file." + (or + (string-match "^#cvs.tfl.[0-9]+$" file) + (string-match "^#cvs.rfl.[0-9]+$" file) + (string-match "^#cvs.wfl.[0-9]+$" file))) + +(defun cvs-skip-line (stdout stderr regexp &optional arg) "Like forward-line, but check that the skipped line matches REGEXP. -If it doesn't match REGEXP (error ERRORMSG) is called. +Args: STDOUT STDERR REGEXP &optional ARG. + +If it doesn't match REGEXP a bug report is generated and displayed. +STDOUT and STDERR is only used to do that. + If optional ARG, a number, is given the ARGth parenthesized expression in the REGEXP is returned as a string. Point should be in column 1 when this function is called." @@ -501,203 +719,297 @@ Point should be in column 1 when this function is called." (buffer-substring (match-beginning arg) (match-end arg)))) (t - (error errormsg)))) - -(defun cvs-get-current-dir (dirname) - "Return current working directory, suitable for cvs-parse-buffer. -Args: DIRNAME. -Concatenates default-directory and DIRNAME to form an absolute path." + (cvs-parse-error stdout stderr + (if (eq (current-buffer) stdout) 'STDOUT 'STDERR) + (point))))) + +(defun cvs-get-current-dir (root-dir dirname) + "Return current working directory, suitable for cvs-parse-update. +Args: ROOT-DIR DIRNAME. +Concatenates ROOT-DIR and DIRNAME to form an absolute path." (if (string= "." dirname) - (substring default-directory 0 -1) - (concat default-directory dirname))) + (substring root-dir 0 -1) + (concat root-dir dirname))) +(defun cvs-compare-fileinfos (a b) + "Compare fileinfo A with fileinfo B and return t if A is `less'." + (cond + ;; Sort acording to directories. + ((string< (cvs-fileinfo->dir a) (cvs-fileinfo->dir b)) t) + ((not (string= (cvs-fileinfo->dir a) (cvs-fileinfo->dir b))) nil) + + ;; The DIRCHANGE entry is always first within the directory. + ((and (eq (cvs-fileinfo->type a) 'DIRCHANGE) + (not (eq (cvs-fileinfo->type b) 'DIRCHANGE))) t) + ((and (eq (cvs-fileinfo->type b) 'DIRCHANGE) + (not (eq (cvs-fileinfo->type a) 'DIRCHANGE))) nil) + ;; All files are sorted by file name. + ((string< (cvs-fileinfo->file-name a) (cvs-fileinfo->file-name b))))) + +(defun cvs-parse-error (stdout-buffer stderr-buffer err-buf pos) + "Handle a parse error when parsing the output from cvs. +Args: STDOUT-BUFFER STDERR-BUFFER ERR-BUF POS. +ERR-BUF should be 'STDOUT or 'STDERR." + (setq pos (1- pos)) + (set-buffer cvs-buffer-name) + (setq buffer-read-only nil) + (erase-buffer) + (insert "To: ceder@lysator.liu.se\n") + (insert "Subject: pcl-cvs " pcl-cvs-version " parse error.\n") + (insert "--text follows this line--\n\n") + (insert "This bug report is automatically generated by pcl-cvs\n") + (insert "because it doesn't understand some output from CVS. Below\n") + (insert "is detailed information about the error. Please send\n") + (insert "this, together with any information you think might be\n") + (insert "useful for me to fix the bug, to the address above. But\n") + (insert "please check the \"known problems\" section of the\n") + (insert "documentation first. Note that this buffer contains\n") + (insert "information that you might consider confidential. You\n") + (insert "are encouraged to read through it before sending it.\n") + (insert "\n") + (insert "Press C-c C-c to send this email.\n\n") + (insert "Please state the version of these programs you are using:\n") + (insert "RCS: \ndiff: \n\n") + + (let* ((stdout (save-excursion (set-buffer stdout-buffer) (buffer-string))) + (stderr (save-excursion (set-buffer stderr-buffer) (buffer-string))) + (errstr (if (eq err-buf 'STDOUT) stdout stderr)) + (errline-end (string-match "\n" errstr pos)) + (errline (substring errstr pos errline-end))) + (insert (format "Offending line (%d chars): >" (- errline-end pos))) + (insert errline) + (insert "<\n") + (insert "Sent to " (symbol-name err-buf) " at pos " (format "%d\n" pos)) + (insert "Emacs-version: " (emacs-version) "\n") + (insert "Pcl-cvs $" "Id:" "$" ": " "Id: pcl-cvs.el,v 1.93 1993/05/31 22:44:00 ceder Exp \n") + (insert "\n") + (insert (format "--- Contents of stdout buffer (%d chars) ---\n" + (length stdout))) + (insert stdout) + (insert "--- End of stdout buffer ---\n") + (insert (format "--- Contents of stderr buffer (%d chars) ---\n" + (length stderr))) + (insert stderr) + (insert "--- End of stderr buffer ---\n") + (insert "End of bug report.\n") + (require 'sendmail) + (mail-mode) + (error "CVS parse error - please report this bug."))) + +(defun cvs-parse-update (stdout-buffer stderr-buffer) + "Parse the output from `cvs update'. + +Args: STDOUT-BUFFER STDERR-BUFFER. + +This functions parses the from `cvs update' (which should be +separated in its stdout- and stderr-components) and prints a +pretty representation of it in the *cvs* buffer. -(defun cvs-parse-buffer () - "Parse the current buffer and select a *cvs* buffer. Signals an error if unexpected output was detected in the buffer." - (goto-char (point-min)) - (let ((buf (get-buffer-create cvs-buffer-name)) - (current-dir default-directory) - (root-dir default-directory) - (parse-buf (current-buffer))) - - (cookie-create - buf 'cvs-pp cvs-startup-message ;Se comment above cvs-startup-message. - "---------- End -----") - - (cookie-enter-first - buf - (cvs-create-fileinfo - 'DIRCHANGE current-dir - nil "")) + (let* ((head (cons 'dummy nil)) + (tail (cvs-parse-stderr stdout-buffer stderr-buffer + head default-directory)) + (root-dir default-directory)) + (cvs-parse-stdout stdout-buffer stderr-buffer tail root-dir) + (setq head (sort (cdr head) (function cvs-compare-fileinfos))) + + (collection-clear cvs-cookie-handle) + (collection-append-cookies cvs-cookie-handle head) + (cvs-remove-stdout-shadows) + (cvs-remove-empty-directories) + (set-buffer cvs-buffer-name) + (cvs-mode) + (goto-char (point-min)) + (tin-goto-previous cvs-cookie-handle (point-min) 1) + (setq default-directory root-dir))) + +(defun cvs-remove-stdout-shadows () + "Remove entries in the *cvs* buffer that comes from both stdout and stderr. +If there is two entries for a single file the second one should be +deleted. (Remember that sort uses a stable sort algorithm, so one can +be sure that the stderr entry is always first)." + (collection-filter-tins cvs-cookie-handle + (function + (lambda (tin) + (not (cvs-shadow-entry-p tin)))))) + +(defun cvs-shadow-entry-p (tin) + "Return non-nil if TIN is a shadow entry. +Args: TIN. +A TIN is a shadow entry if the previous tin contains the same file." + (let* ((previous-tin (tin-previous cvs-cookie-handle tin)) + (curr (tin-cookie cvs-cookie-handle tin)) + (prev (and previous-tin + (tin-cookie cvs-cookie-handle previous-tin)))) + (and + prev curr + (string= (cvs-fileinfo->file-name prev) (cvs-fileinfo->file-name curr)) + (string= (cvs-fileinfo->dir prev) (cvs-fileinfo->dir curr)) + (or + (and (eq (cvs-fileinfo->type prev) 'CONFLICT) + (eq (cvs-fileinfo->type curr) 'CONFLICT)) + (and (eq (cvs-fileinfo->type prev) 'MERGED) + (eq (cvs-fileinfo->type curr) 'MODIFIED)) + (and (eq (cvs-fileinfo->type prev) 'REM-EXIST) + (eq (cvs-fileinfo->type curr) 'REMOVED)))))) + + +(defun cvs-parse-stderr (stdout-buffer stderr-buffer head dir) + "Parse the output from CVS that is written to stderr. +Args: STDOUT-BUFFER STDERR-BUFFER HEAD DIR +STDOUT-BUFFER holds the output that cvs sent to stdout. It is only +used to create a bug report in case there is a parse error. +STDERR-BUFFER is the buffer that holds the output to parse. +HEAD is a cons-cell, the head of the list that is built. +DIR is the directory the `cvs update' was run in. + +This function returns the last cons-cell in the list that is built." - (while (< (point) (point-max)) - (cond + (save-window-excursion + (set-buffer stderr-buffer) + (goto-char (point-min)) + (let ((current-dir dir) + (root-dir dir)) - ;; CVS is descending a subdirectory. + (while (< (point) (point-max)) + (cond - ((looking-at "cvs update: Updating \\(.*\\)$") - (setq current-dir - (cvs-get-current-dir - (buffer-substring (match-beginning 1) (match-end 1)))) + ;; RCVS support (for now, we simply ignore any output from + ;; RCVS, including error messages!) - ;; Omit empty directories. - (if (eq (cvs-fileinfo->type (cookie-last buf)) - 'DIRCHANGE) - (cookie-delete-last buf)) + ((looking-at "updating of .* finished$") + (forward-line 1)) - (cookie-enter-last - buf - (cvs-create-fileinfo - 'DIRCHANGE current-dir - nil (buffer-substring (match-beginning 0) - (match-end 0)))) - (forward-line 1)) + ((looking-at "REMOTE FOLDER:.*") + (forward-line 1) + (while (and (< (point) (point-max)) (not (looking-at "phase 2.*"))) + (forward-line 1)) + (forward-line 2)) - ;; File removed, since it is removed (by third party) in repository. + ((looking-at "turn on remote mode$") + (forward-line 1) + (while (and (< (point) (point-max)) (not (looking-at "phase 2.*"))) + (forward-line 1)) + (forward-line 2)) + + ((looking-at "phase 3.*") + (goto-char (point-max))) + + ;; End of RCVS stuff. + + ;; CVS is descending a subdirectory. + + ((looking-at "cvs update: Updating \\(.*\\)$") + (setq current-dir + (cvs-get-current-dir + root-dir + (buffer-substring (match-beginning 1) (match-end 1)))) + (setcdr head (list (cvs-create-fileinfo + 'DIRCHANGE current-dir + nil (buffer-substring (match-beginning 0) + (match-end 0))))) + (setq head (cdr head)) + (forward-line 1)) + + ;; File removed, since it is removed (by third party) in repository. - ((or (looking-at "cvs update: warning: \\(.*\\) is not (any longer) \ -pertinent") - (looking-at "cvs update: \\(.*\\) is no longer in the repository")) - (cookie-enter-last - buf - (cvs-create-fileinfo - 'CVS-REMOVED current-dir - (file-name-nondirectory - (buffer-substring (match-beginning 1) (match-end 1))) - (buffer-substring (match-beginning 0) - (match-end 0)))) - (forward-line 1)) - - ;; File removed by you, but recreated by cvs. Ignored. - - ((looking-at "cvs update: warning: .* was lost$") - (forward-line 1)) - - ;; A file that has been created by you, but added to the cvs - ;; repository by another. - - ((looking-at "^cvs update: move away \\(.*\\); it is in the way$") - (cookie-enter-last - buf - (cvs-create-fileinfo - 'MOVE-AWAY current-dir - (file-name-nondirectory - (buffer-substring (match-beginning 1) (match-end 1))) - (buffer-substring (match-beginning 0) - (match-end 0)))) - (forward-line 1)) - - ;; Empty line. Probably inserted by mistake by user (or developer :-) - ;; Ignore. - - ((looking-at "^$") - (forward-line 1)) - - ;; Cvs waits for a lock. Ignore. - - ((looking-at - "^cvs update: \\[..:..:..\\] waiting for .*lock in ") - (forward-line 1)) - - ;; File removed in repository, but edited by you. - - ((looking-at - "cvs update: conflict: \\(.*\\) is modified but no longer \ + ((or (looking-at + "cvs update: warning: \\(.*\\) is not (any longer) pertinent") + (looking-at + "cvs update: \\(.*\\) is no longer in the repository")) + + (setcdr head (list (cvs-create-fileinfo + 'CVS-REMOVED current-dir + (file-name-nondirectory + (buffer-substring (match-beginning 1) + (match-end 1))) + (buffer-substring (match-beginning 0) + (match-end 0))))) + (setq head (cdr head)) + (forward-line 1)) + + ;; File removed by you, but recreated by cvs. Ignored. + + ((looking-at "cvs update: warning: .* was lost$") + (forward-line 1)) + + ;; A file that has been created by you, but added to the cvs + ;; repository by another. + + ((looking-at "^cvs update: move away \\(.*\\); it is in the way$") + (setcdr head (list (cvs-create-fileinfo + 'MOVE-AWAY current-dir + (file-name-nondirectory + (buffer-substring (match-beginning 1) + (match-end 1))) + (buffer-substring (match-beginning 0) + (match-end 0))))) + (setq head (cdr head)) + (forward-line 1)) + + ;; Empty line. Probably inserted by mistake by user (or developer :-) + ;; Ignore. + + ((looking-at "^$") + (forward-line 1)) + + ;; Cvs waits for a lock. Ignore. + + ((looking-at + "^cvs update: \\[..:..:..\\] waiting for .*lock in ") + (forward-line 1)) + + ;; File removed in repository, but edited by you. + + ((looking-at + "cvs update: conflict: \\(.*\\) is modified but no longer \ in the repository$") - (cookie-enter-last - buf - (cvs-create-fileinfo - 'REM-CONFLICT current-dir - (file-name-nondirectory - (buffer-substring (match-beginning 1) (match-end 1))) - (buffer-substring (match-beginning 0) - (match-end 0)))) - (forward-line 1)) - - ((looking-at - "cvs update: conflict: removed \\(.*\\) was modified by second party") - (cvs-create-fileinfo - 'MOD-CONFLICT current-dir - (buffer-substring (match-beginning 1) (match-end 1)) - (buffer-substring (match-beginning 0) (match-end 0))) - (forward-line 1)) - - ((looking-at "cvs update: in directory ") - (let ((start (point))) - (forward-line 1) - (cvs-skip-line - (regexp-quote "cvs [update aborted]: there is no repository ") - "Unexpected cvs output.") - (cookie-enter-last - buf - (cvs-create-fileinfo - 'REPOS-MISSING current-dir - nil - (buffer-substring start (point)))))) - - ;; The file is copied from the repository. - - ((looking-at "U \\(.*\\)$") - (cookie-enter-last - buf - (let ((fileinfo - (cvs-create-fileinfo - 'UPDATED current-dir - (file-name-nondirectory - (buffer-substring (match-beginning 1) (match-end 1))) - (buffer-substring (match-beginning 0) (match-end 0))))) - (cvs-set-fileinfo->handled fileinfo t) - fileinfo)) - (forward-line 1)) - - ;; The file is modified by the user, and untouched in the repository. - - ((looking-at "M \\(.*\\)$") - (cookie-enter-last - buf - (cvs-create-fileinfo - 'MODIFIED current-dir - (file-name-nondirectory - (buffer-substring (match-beginning 1) (match-end 1))) - (buffer-substring (match-beginning 0) (match-end 0)))) - (forward-line 1)) - - ;; The file is "cvs add"ed, but not "cvs ci"ed. - - ((looking-at "A \\(.*\\)$") - (cookie-enter-last - buf - (cvs-create-fileinfo - 'ADDED current-dir - (file-name-nondirectory - (buffer-substring (match-beginning 1) (match-end 1))) - (buffer-substring (match-beginning 0) (match-end 0)))) - (forward-line 1)) - - ;; The file is "cvs remove"ed, but not "cvs ci"ed. - - ((looking-at "R \\(.*\\)$") - (cookie-enter-last - buf - (cvs-create-fileinfo - 'REMOVED current-dir - (file-name-nondirectory - (buffer-substring (match-beginning 1) (match-end 1))) - (buffer-substring (match-beginning 0) (match-end 0)))) - (forward-line 1)) - - ;; Unknown file. + (setcdr head (list + (cvs-create-fileinfo + 'REM-CONFLICT current-dir + (file-name-nondirectory + (buffer-substring (match-beginning 1) (match-end 1))) + (buffer-substring (match-beginning 0) + (match-end 0))))) + (setq head (cdr head)) + (forward-line 1)) + + ((looking-at + "cvs update: conflict: removed \\(.*\\) was modified by \ +second party") + (setcdr head + (list + (cvs-create-fileinfo + 'MOD-CONFLICT current-dir + (buffer-substring (match-beginning 1) (match-end 1)) + (buffer-substring (match-beginning 0) (match-end 0))))) + (setq head (cdr head)) + (forward-line 1)) + + ((looking-at + "cvs update: \\(.*\\) should be removed and is still there") + (setcdr head + (list + (cvs-create-fileinfo + 'REM-EXIST current-dir + (buffer-substring (match-beginning 1) (match-end 1)) + (buffer-substring (match-beginning 0) (match-end 0))))) + (setq head (cdr head)) + (forward-line 1)) + + ((looking-at "cvs update: in directory ") + (let ((start (point))) + (forward-line 1) + (cvs-skip-line + stdout-buffer stderr-buffer + (regexp-quote "cvs [update aborted]: there is no repository ")) + (setcdr head (list + (cvs-create-fileinfo + 'REPOS-MISSING current-dir + nil + (buffer-substring start (point))))) + (setq head (cdr head)))) - ((looking-at "? \\(.*\\)$") - (cookie-enter-last - buf - (cvs-create-fileinfo - 'UNKNOWN current-dir - (file-name-nondirectory - (buffer-substring (match-beginning 1) (match-end 1))) - (buffer-substring (match-beginning 0) (match-end 0)))) - (forward-line 1)) (t ;; CVS has decided to merge someone elses changes into this @@ -708,79 +1020,149 @@ in the repository$") (let ((complex-start (point)) initial-revision filename) - (cvs-skip-line "^RCS file: .*$" "Parse error.") + (cvs-skip-line stdout-buffer stderr-buffer "^RCS file: .*$") (setq initial-revision - (cvs-skip-line "^retrieving revision \\(.*\\)$" - "Unexpected output from cvs." 1)) - (cvs-skip-line "^retrieving revision .*$" - "Unexpected output from cvs.") + (cvs-skip-line stdout-buffer stderr-buffer + "^retrieving revision \\(.*\\)$" 1)) + (cvs-skip-line stdout-buffer stderr-buffer + "^retrieving revision .*$") ;; Get the file name from the next line. (setq filename (cvs-skip-line + stdout-buffer stderr-buffer "^Merging differences between [0-9.]+ and [0-9.]+ into \\(.*\\)$" - "Unexpected output from cvs." 1)) (cond + ;; Was it a conflict? + ((looking-at + ;; Allow both RCS 5.5 and 5.6. (5.6 prints "rcs" and " warning"). + "^\\(rcs\\)?merge\\( warning\\)?: overlaps during merge$") - ;; The file was successfully merged. + ;; Yes, this is a conflict. + (cvs-skip-line + stdout-buffer stderr-buffer + "^\\(rcs\\)?merge\\( warning\\)?: overlaps during merge$") + + (cvs-skip-line stdout-buffer stderr-buffer + "^cvs update: conflicts found in ") - ((looking-at "^M ") - (forward-line 1) (let ((fileinfo (cvs-create-fileinfo - 'MERGED current-dir + 'CONFLICT current-dir filename (buffer-substring complex-start (point))))) - (cvs-set-fileinfo->backup-file - fileinfo - (concat cvs-bakprefix filename "." initial-revision)) - (cookie-enter-last - buf fileinfo))) - ;; A conflicting merge. + (cvs-set-fileinfo->base-revision fileinfo initial-revision) + + (setcdr head (list fileinfo)) + (setq head (cdr head)))) + + ;; Was it a conflict, and was RCS compiled without DIFF3_BIN? + + ((looking-at + ;; Allow both RCS 5.5 and 5.6. (5.6 prints "rcs" and " warning"). + "^\\(rcs\\)?merge\\( warning\\)?: overlaps or other probl\ +ems during merge$") + + ;; Yes, this is a conflict. + (cvs-skip-line + stdout-buffer stderr-buffer + "^\\(rcs\\)?merge\\( warning\\)?: overlaps .*during merge$") + + (cvs-skip-line stdout-buffer stderr-buffer + "^cvs update: could not merge ") + (cvs-skip-line stdout-buffer stderr-buffer + "^cvs update: restoring .* from backup file ") - (t - (cvs-skip-line "^merge: overlaps during merge$" - "Unexpected output from cvs.") - (cvs-skip-line "^cvs update: conflicts found in " - "Unexpected output from cvs.") - (cvs-skip-line "^C " "Unexpected cvs output.") (let ((fileinfo (cvs-create-fileinfo 'CONFLICT current-dir filename (buffer-substring complex-start (point))))) - (cvs-set-fileinfo->backup-file - fileinfo - (concat cvs-bakprefix filename "." initial-revision)) + (setcdr head (list fileinfo)) + (setq head (cdr head)))) + + (t + ;; Not a conflict; it must be a succesful merge. + (let ((fileinfo + (cvs-create-fileinfo + 'MERGED current-dir + filename + (buffer-substring complex-start (point))))) + (cvs-set-fileinfo->base-revision fileinfo initial-revision) + (setcdr head (list fileinfo)) + (setq head (cdr head))))))))))) + head) - (cookie-enter-last buf fileinfo)))))))) - ;; All parsing is done. +(defun cvs-parse-stdout (stdout-buffer stderr-buffer head root-dir) + "Parse the output from CVS that is written to stderr. +Args: STDOUT-BUFFER STDERR-BUFFER HEAD ROOT-DIR +STDOUT-BUFFER is the buffer that holds the output to parse. +STDERR-BUFFER holds the output that cvs sent to stderr. It is only +used to create a bug report in case there is a parse error. - ;; If the last entry is a directory, remove it. - (if (eq (cvs-fileinfo->type (cookie-last buf)) - 'DIRCHANGE) - (cookie-delete-last buf)) +HEAD is a cons-cell, the head of the list that is built. +ROOT-DIR is the directory the `cvs update' was run in. - (set-buffer buf) - (cvs-mode) - (setq cookie-last-tin (cookie-nth buf 0)) +This function doesn't return anything particular." + (save-window-excursion + (set-buffer stdout-buffer) (goto-char (point-min)) - (cookie-previous-cookie buf (point-min) 1) - (setq default-directory root-dir) - (if (get-buffer-window parse-buf) - (set-window-buffer (get-buffer-window parse-buf) buf) - (display-buffer buf)))) + (while (< (point) (point-max)) + (cond + ;; M: The file is modified by the user, and untouched in the repository. + ;; A: The file is "cvs add"ed, but not "cvs ci"ed. + ;; R: The file is "cvs remove"ed, but not "cvs ci"ed. + ;; C: Conflict + ;; U: The file is copied from the repository. + ;; ?: Unknown file. + + + ((looking-at "\\([MARCU?]\\) \\(.*\\)$") + (let* + ((c (char-after (match-beginning 1))) + (full-path + (concat (file-name-as-directory root-dir) + (buffer-substring (match-beginning 2) (match-end 2)))) + (fileinfo (cvs-create-fileinfo + (cond ((eq c ?M) 'MODIFIED) + ((eq c ?A) 'ADDED) + ((eq c ?R) 'REMOVED) + ((eq c ?C) 'CONFLICT) + ((eq c ?U) 'UPDATED) + ((eq c ??) 'UNKNOWN)) + (substring (file-name-directory full-path) 0 -1) + (file-name-nondirectory full-path) + (buffer-substring (match-beginning 0) (match-end 0))))) + ;; Updated files require no further action. + (if (eq c ?U) + (cvs-set-fileinfo->handled fileinfo t)) + + ;; Link this last on the list. + (setcdr head (list fileinfo)) + (setq head (cdr head)) + (forward-line 1))) + + ;; Executing a program because of the -u option in modules. + ((looking-at "cvs update: Executing") + ;; Skip by any output the program may generate to stdout. + ;; Note that pcl-cvs will get seriously confused if the + ;; program prints anything to stderr. + (re-search-forward cvs-update-prog-output-skip-regexp) + (forward-line 1)) + + (t (cvs-parse-error stdout-buffer stderr-buffer 'STDOUT (point))))))) (defun cvs-pp (fileinfo) - "Pretty print FILEINFO into a string." + "Pretty print FILEINFO. Insert a printed representation in current buffer. +For use by the cookie package." (let ((a (cvs-fileinfo->type fileinfo)) (s (if (cvs-fileinfo->marked fileinfo) @@ -788,36 +1170,41 @@ in the repository$") (f (cvs-fileinfo->file-name fileinfo)) (ci (if (cvs-fileinfo->handled fileinfo) " " "ci"))) - (cond - ((eq a 'UPDATED) - (format "%s Updated %s" s f)) - ((eq a 'MODIFIED) - (format "%s Modified %s %s" s ci f)) - ((eq a 'MERGED) - (format "%s Merged %s %s" s ci f)) - ((eq a 'CONFLICT) - (format "%s Conflict %s" s f)) - ((eq a 'ADDED) - (format "%s Added %s %s" s ci f)) - ((eq a 'REMOVED) - (format "%s Removed %s %s" s ci f)) - ((eq a 'UNKNOWN) - (format "%s Unknown %s" s f)) - ((eq a 'CVS-REMOVED) - (format "%s Removed from repository: %s" s f)) - ((eq a 'REM-CONFLICT) - (format "%s Conflict: Removed from repository, changed by you: %s" s f)) - ((eq a 'MOD-CONFLICT) - (format "%s Conflict: Removed by you, changed in repository: %s" s f)) - ((eq a 'DIRCHANGE) - (format "\nIn directory %s:" - (cvs-fileinfo->dir fileinfo))) - ((eq a 'MOVE-AWAY) - (format "%s Move away %s - it is in the way" s f)) - ((eq a 'REPOS-MISSING) - (format " This repository is missing! Remove this dir manually.")) - (t - (format "%s Internal error! %s" s f))))) + (insert + (cond + ((eq a 'UPDATED) + (format "%s Updated %s" s f)) + ((eq a 'MODIFIED) + (format "%s Modified %s %s" s ci f)) + ((eq a 'MERGED) + (format "%s Merged %s %s" s ci f)) + ((eq a 'CONFLICT) + (format "%s Conflict %s" s f)) + ((eq a 'ADDED) + (format "%s Added %s %s" s ci f)) + ((eq a 'REMOVED) + (format "%s Removed %s %s" s ci f)) + ((eq a 'UNKNOWN) + (format "%s Unknown %s" s f)) + ((eq a 'CVS-REMOVED) + (format "%s Removed from repository: %s" s f)) + ((eq a 'REM-CONFLICT) + (format "%s Conflict: Removed from repository, changed by you: %s" s f)) + ((eq a 'MOD-CONFLICT) + (format "%s Conflict: Removed by you, changed in repository: %s" s f)) + ((eq a 'REM-EXIST) + (format "%s Conflict: Removed by you, but still exists: %s" s f)) + ((eq a 'DIRCHANGE) + (format "\nIn directory %s:" + (cvs-fileinfo->dir fileinfo))) + ((eq a 'MOVE-AWAY) + (format "%s Move away %s - it is in the way" s f)) + ((eq a 'REPOS-MISSING) + (format " This repository is missing! Remove this dir manually.")) + ((eq a 'MESSAGE) + (cvs-fileinfo->full-log fileinfo)) + (t + (format "%s Internal error! %s" s f)))))) ;;; You can define your own keymap in .emacs. pcl-cvs.el won't overwrite it. @@ -826,56 +1213,61 @@ in the repository$") nil (setq cvs-mode-map (make-keymap)) (suppress-keymap cvs-mode-map) - (define-key cvs-mode-map " " 'cookie-next-cookie) + (define-key cvs-mode-map " " 'cvs-mode-next-line) (define-key cvs-mode-map "?" 'describe-mode) - (define-key cvs-mode-map "A" 'cvs-add-change-log-entry-other-window) - (define-key cvs-mode-map "M" 'cvs-mark-all-files) - (define-key cvs-mode-map "U" 'cvs-unmark-all-files) - (define-key cvs-mode-map "\C-?" 'cvs-unmark-up) - (define-key cvs-mode-map "\C-n" 'cookie-next-cookie) - (define-key cvs-mode-map "\C-p" 'cookie-previous-cookie) - (define-key cvs-mode-map "a" 'cvs-add) - (define-key cvs-mode-map "b" 'cvs-diff-backup) - (define-key cvs-mode-map "c" 'cvs-commit) - (define-key cvs-mode-map "d" 'cvs-diff-cvs) - (define-key cvs-mode-map "f" 'cvs-find-file) - (define-key cvs-mode-map "g" 'cvs-update-no-prompt) - (define-key cvs-mode-map "i" 'cvs-ignore) - (define-key cvs-mode-map "l" 'cvs-log) - (define-key cvs-mode-map "m" 'cvs-mark) - (define-key cvs-mode-map "n" 'cookie-next-cookie) - (define-key cvs-mode-map "o" 'cvs-find-file-other-window) - (define-key cvs-mode-map "p" 'cookie-previous-cookie) - (define-key cvs-mode-map "r" 'cvs-remove-file) - (define-key cvs-mode-map "s" 'cvs-status) - (define-key cvs-mode-map "\C-k" 'cvs-acknowledge) - (define-key cvs-mode-map "x" 'cvs-remove-handled) - (define-key cvs-mode-map "u" 'cvs-unmark)) - - -(defun cvs-get-marked () + (define-key cvs-mode-map "A" 'cvs-mode-add-change-log-entry-other-window) + (define-key cvs-mode-map "M" 'cvs-mode-mark-all-files) + (define-key cvs-mode-map "R" 'cvs-mode-revert-updated-buffers) + (define-key cvs-mode-map "U" 'cvs-mode-undo-local-changes) + (define-key cvs-mode-map "\C-?" 'cvs-mode-unmark-up) + (define-key cvs-mode-map "\C-k" 'cvs-mode-acknowledge) + (define-key cvs-mode-map "\C-n" 'cvs-mode-next-line) + (define-key cvs-mode-map "\C-p" 'cvs-mode-previous-line) + (define-key cvs-mode-map "\M-\C-?" 'cvs-mode-unmark-all-files) + (define-key cvs-mode-map "a" 'cvs-mode-add) + (define-key cvs-mode-map "b" 'cvs-mode-diff-backup) + (define-key cvs-mode-map "c" 'cvs-mode-commit) + (define-key cvs-mode-map "d" 'cvs-mode-diff-cvs) + (define-key cvs-mode-map "e" 'cvs-mode-emerge) + (define-key cvs-mode-map "f" 'cvs-mode-find-file) + (define-key cvs-mode-map "g" 'cvs-mode-update-no-prompt) + (define-key cvs-mode-map "i" 'cvs-mode-ignore) + (define-key cvs-mode-map "l" 'cvs-mode-log) + (define-key cvs-mode-map "m" 'cvs-mode-mark) + (define-key cvs-mode-map "n" 'cvs-mode-next-line) + (define-key cvs-mode-map "o" 'cvs-mode-find-file-other-window) + (define-key cvs-mode-map "p" 'cvs-mode-previous-line) + (define-key cvs-mode-map "q" 'bury-buffer) + (define-key cvs-mode-map "r" 'cvs-mode-remove-file) + (define-key cvs-mode-map "s" 'cvs-mode-status) + (define-key cvs-mode-map "x" 'cvs-mode-remove-handled) + (define-key cvs-mode-map "u" 'cvs-mode-unmark)) + + +(defun cvs-get-marked (&optional ignore-marks) "Return a list of all selected tins. -If there are any marked tins, return them. +If there are any marked tins, and IGNORE-MARKS is nil, return them. Otherwise, if the cursor selects a directory, return all files in it. Otherwise return (a list containing) the file the cursor points to, or -an empty list if it doesn't point to a file at all." +an empty list if it doesn't point to a file at all. + +Args: &optional IGNORE-MARKS." (cond ;; Any marked cookies? - ((cookie-collect-tins (current-buffer) - 'cvs-fileinfo->marked)) + ((and (not ignore-marks) + (collection-collect-tin cvs-cookie-handle 'cvs-fileinfo->marked))) ;; Nope. (t - (let ((sel (cookie-get-selection - (current-buffer) (point) cookie-last-tin))) + (let ((sel (tin-locate cvs-cookie-handle (point)))) (cond ;; If a directory is selected, all it members are returned. ((and sel (eq (cvs-fileinfo->type - (cookie-cookie (current-buffer) sel)) + (tin-cookie cvs-cookie-handle sel)) 'DIRCHANGE)) - (cookie-collect-tins - (current-buffer) 'cvs-dir-member-p - (cvs-fileinfo->dir (cookie-cookie (current-buffer) sel)))) + (collection-collect-tin + cvs-cookie-handle 'cvs-dir-member-p + (cvs-fileinfo->dir (tin-cookie cvs-cookie-handle sel)))) (t (list sel))))))) @@ -885,30 +1277,66 @@ an empty list if it doesn't point to a file at all." (and (not (eq (cvs-fileinfo->type fileinfo) 'DIRCHANGE)) (string= (cvs-fileinfo->dir fileinfo) dir))) -(defun cvs-dir-empty-p (cvs-buf tin) +(defun cvs-dir-empty-p (tin) "Return non-nil if TIN is a directory that is empty. Args: CVS-BUF TIN." - (and (eq (cvs-fileinfo->type (cookie-cookie cvs-buf tin)) 'DIRCHANGE) - (or (not (cookie-next cvs-buf tin)) - (eq (cvs-fileinfo->type (cookie-cookie cvs-buf - (cookie-next cvs-buf tin))) + (and (eq (cvs-fileinfo->type (tin-cookie cvs-cookie-handle tin)) 'DIRCHANGE) + (or (not (tin-next cvs-cookie-handle tin)) + (eq (cvs-fileinfo->type + (tin-cookie cvs-cookie-handle + (tin-next cvs-cookie-handle tin))) 'DIRCHANGE)))) -(defun cvs-remove-handled () +(defun cvs-mode-revert-updated-buffers () + "Revert any buffers that are UPDATED, MERGED or CONFLICT." + (interactive) + (cookie-map (function cvs-revert-fileinfo) cvs-cookie-handle)) + +(defun cvs-revert-fileinfo (fileinfo) + "Revert the buffer that holds the file in FILEINFO if it has changed, +and if the type is UPDATED, MERGED or CONFLICT." + (let* ((type (cvs-fileinfo->type fileinfo)) + (file (cvs-fileinfo->full-path fileinfo)) + (buffer (get-file-buffer file))) + ;; For a revert to happen... + (cond + ((and + ;; ...the type must be one that justifies a revert... + (or (eq type 'UPDATED) + (eq type 'MERGED) + (eq type 'CONFLICT)) + ;; ...and the user must be editing the file... + buffer) + (save-excursion + (set-buffer buffer) + (cond + ((buffer-modified-p) + (error "%s: edited since last cvs-update." + (buffer-file-name))) + ;; Go ahead and revert the file. + (t (revert-buffer 'dont-use-auto-save-file 'dont-ask)))))))) + + +(defun cvs-mode-remove-handled () "Remove all lines that are handled. Empty directories are removed." (interactive) ;; Pass one: remove files that are handled. - (cookie-filter (current-buffer) + (collection-filter-cookies cvs-cookie-handle (function (lambda (fileinfo) (not (cvs-fileinfo->handled fileinfo))))) ;; Pass two: remove empty directories. - (cookie-filter-tins (current-buffer) - (function - (lambda (tin) - (not (cvs-dir-empty-p (current-buffer) tin)))))) + (cvs-remove-empty-directories)) + -(defun cvs-mark (pos) +(defun cvs-remove-empty-directories () + "Remove empty directories in the *cvs* buffer." + (collection-filter-tins cvs-cookie-handle + (function + (lambda (tin) + (not (cvs-dir-empty-p tin)))))) + +(defun cvs-mode-mark (pos) "Mark a fileinfo. Args: POS. If the fileinfo is a directory, all the contents of that directory are marked instead. A directory can never be marked. @@ -916,9 +1344,8 @@ POS is a buffer position." (interactive "d") - (let* ((tin (cookie-get-selection - (current-buffer) pos cookie-last-tin)) - (sel (cookie-cookie (current-buffer) tin))) + (let* ((tin (tin-locate cvs-cookie-handle pos)) + (sel (tin-cookie cvs-cookie-handle tin))) (cond ;; Does POS point to a directory? If so, mark all files in that directory. @@ -929,20 +1356,20 @@ POS is a buffer position." ((cvs-dir-member-p f dir) (cvs-set-fileinfo->marked f t) t)))) ;Tell cookie to redisplay this cookie. - (current-buffer) + cvs-cookie-handle (cvs-fileinfo->dir sel))) (t (cvs-set-fileinfo->marked sel t) - (cookie-invalidate-tins (current-buffer) tin) - (cookie-next-cookie (current-buffer) pos 1))))) + (tin-invalidate cvs-cookie-handle tin) + (tin-goto-next cvs-cookie-handle pos 1))))) -(defun cvs-committable (tin cvs-buf) +(defun cvs-committable (tin) "Check if the TIN is committable. It is committable if it a) is not handled and b) is either MODIFIED, ADDED, REMOVED, MERGED or CONFLICT." - (let* ((fileinfo (cookie-cookie cvs-buf tin)) + (let* ((fileinfo (tin-cookie cvs-cookie-handle tin)) (type (cvs-fileinfo->type fileinfo))) (and (not (cvs-fileinfo->handled fileinfo)) (or (eq type 'MODIFIED) @@ -951,7 +1378,7 @@ It is committable if it (eq type 'MERGED) (eq type 'CONFLICT))))) -(defun cvs-commit () +(defun cvs-mode-commit () "Check in all marked files, or the current file. The user will be asked for a log message in a buffer. @@ -963,8 +1390,7 @@ buffer so that it is easy to kill the contents of the buffer with \\[kill-region (let* ((cvs-buf (current-buffer)) (marked (cvs-filter (function cvs-committable) - (cvs-get-marked) - cvs-buf))) + (cvs-get-marked)))) (if (null marked) (error "Nothing to commit!") (pop-to-buffer (get-buffer-create cvs-commit-prompt-buffer)) @@ -976,35 +1402,68 @@ buffer so that it is easy to kill the contents of the buffer with \\[kill-region (cvs-edit-mode) (make-local-variable 'cvs-commit-list) (setq cvs-commit-list marked) - (make-local-variable 'cvs-cvs-buffer) - (setq cvs-cvs-buffer cvs-buf) (message "Press C-c C-c when you are done editing.")))) (defun cvs-edit-done () "Commit the files to the repository." (interactive) + (if (null cvs-commit-list) + (error "You have already commited the files")) + (if (and (> (point-max) 1) + (/= (char-after (1- (point-max))) ?\n) + (or (eq cvs-commit-buffer-require-final-newline t) + (and cvs-commit-buffer-require-final-newline + (yes-or-no-p + (format "Buffer %s does not end in newline. Add one? " + (buffer-name)))))) + (save-excursion + (goto-char (point-max)) + (insert ?\n))) (save-some-buffers) (let ((cc-list cvs-commit-list) - (cc-buffer cvs-cvs-buffer) + (cc-buffer (get-buffer cvs-buffer-name)) (msg-buffer (current-buffer)) (msg (buffer-substring (point-min) (point-max)))) (pop-to-buffer cc-buffer) (bury-buffer msg-buffer) (cvs-use-temp-buffer) (message "Committing...") - (cvs-execute-list cc-list cvs-program (list "commit" "-m" msg)) - (mapcar (function - (lambda (tin) - (cvs-set-fileinfo->handled (cookie-cookie cc-buffer tin) t))) - cc-list) - (apply 'cookie-invalidate-tins cc-buffer cc-list) + (if (cvs-execute-list cc-list cvs-program + (if cvs-cvsroot + (list "-d" cvs-cvsroot "commit" "-m" msg) + (list "commit" "-m" msg))) + (error "Something went wrong. Check the %s buffer carefully." + cvs-temp-buffer-name)) + (let ((ccl cc-list)) + (while ccl + (cvs-after-commit-function (tin-cookie cvs-cookie-handle (car ccl))) + (setq ccl (cdr ccl)))) + (apply 'tin-invalidate cvs-cookie-handle cc-list) + (set-buffer msg-buffer) + (setq cvs-commit-list nil) (set-buffer cc-buffer) (if cvs-auto-remove-handled - (cvs-remove-handled))) + (cvs-mode-remove-handled))) (message "Committing... Done.")) +(defun cvs-after-commit-function (fileinfo) + "Do everything that needs to be done when FILEINFO has been commited. +The fileinfo->handle is set, and if the buffer is present it is reverted." + (cvs-set-fileinfo->handled fileinfo t) + (if cvs-auto-revert-after-commit + (let* ((file (cvs-fileinfo->full-path fileinfo)) + (buffer (get-file-buffer file))) + ;; For a revert to happen... + (if buffer + ;; ...the user must be editing the file... + (save-excursion + (set-buffer buffer) + (if (not (buffer-modified-p)) + ;; ...but it must be unmodified. + (revert-buffer 'dont-use-auto-save-file 'dont-ask))))))) + (defun cvs-execute-list (tin-list program constant-args) "Run PROGRAM on all elements on TIN-LIST. @@ -1015,11 +1474,19 @@ arguments given to the program will be CONSTANT-ARGS followed by all the files (from TIN-LIST) that resides in that directory. If the files in TIN-LIST resides in different directories the PROGRAM will be run once for each directory (if all files in the same directory appears -after each other." - +after each other). + +Any output from PROGRAM will be inserted in the current buffer. + +This function return nil if all went well, or the numerical exit +status or a signal name as a string. Note that PROGRAM might be called +several times. This will return non-nil if something goes wrong, but +there is no way to know which process that failed." + + (let ((exitstatus nil)) (while tin-list (let ((current-dir (cvs-fileinfo->dir - (cookie-cookie cvs-buffer-name + (tin-cookie cvs-cookie-handle (car tin-list)))) arg-list arg-str) @@ -1029,10 +1496,10 @@ after each other." (string= current-dir (cvs-fileinfo->dir - (cookie-cookie cvs-buffer-name (car tin-list))))) + (tin-cookie cvs-cookie-handle (car tin-list))))) (setq arg-list (cons (cvs-fileinfo->file-name - (cookie-cookie cvs-buffer-name (car tin-list))) + (tin-cookie cvs-cookie-handle (car tin-list))) arg-list)) (setq tin-list (cdr tin-list))) @@ -1048,9 +1515,15 @@ after each other." (nconc (copy-sequence constant-args) arg-list) " "))) - (apply 'call-process program nil t t - (nconc (copy-sequence constant-args) arg-list)) - (goto-char (point-max))))) + (let ((res (apply 'call-process program nil t t + (nconc (copy-sequence constant-args) arg-list)))) + ;; Remember the first, or highest, exitstatus. + (if (and (not (and (integerp res) (zerop res))) + (or (null exitstatus) + (and (integerp exitstatus) (= 1 exitstatus)))) + (setq exitstatus res))) + (goto-char (point-max)))) + exitstatus)) (defun cvs-execute-single-file-list (tin-list extractor program constant-args) @@ -1070,11 +1543,11 @@ this file, or a list of arguments to send to the program." (while tin-list (let ((default-directory (file-name-as-directory (cvs-fileinfo->dir - (cookie-cookie cvs-buffer-name - (car tin-list))))) + (tin-cookie cvs-cookie-handle + (car tin-list))))) (arg-list (funcall extractor - (cookie-cookie cvs-buffer-name (car tin-list))))) + (tin-cookie cvs-cookie-handle (car tin-list))))) ;; Execute the command unless extractor returned t. @@ -1113,36 +1586,87 @@ This mode is based on fundamental mode." (define-key cvs-edit-mode-map "\C-c\C-c" 'cvs-edit-done)) -(defun cvs-diff-cvs () +(defun cvs-diffable (tins) + "Return a list of all tins on TINS that it makes sense to run +``cvs diff'' on." + ;; +++ There is an unnecessary (nreverse) here. Get the list the + ;; other way around instead! + (let ((result nil)) + (while tins + (let ((type (cvs-fileinfo->type + (tin-cookie cvs-cookie-handle (car tins))))) + (if (or (eq type 'MODIFIED) + (eq type 'UPDATED) + (eq type 'MERGED) + (eq type 'CONFLICT) + (eq type 'REMOVED) ;+++Does this line make sense? + (eq type 'ADDED)) ;+++Does this line make sense? + (setq result (cons (car tins) result))) + (setq tins (cdr tins)))) + (nreverse result))) + + +(defun cvs-mode-diff-cvs (&optional ignore-marks) "Diff the selected files against the repository. -The flags the variable cvs-cvs-diff-flags will be passed to ``cvs diff''." - (interactive) +The flags in the variable cvs-diff-flags (which should be a list +of strings) will be passed to ``cvs diff''. If the variable +cvs-diff-ignore-marks is non-nil any marked files will not be +considered to be selected. An optional prefix argument will invert +the influence from cvs-diff-ignore-marks." + + (interactive "P") + + (if (not (listp cvs-diff-flags)) + (error "cvs-diff-flags should be a list of strings")) (save-some-buffers) - (let ((marked (cvs-get-marked))) + (let ((marked (cvs-diffable + (cvs-get-marked + (or (and ignore-marks (not cvs-diff-ignore-marks)) + (and (not ignore-marks) cvs-diff-ignore-marks)))))) (cvs-use-temp-buffer) (message "cvsdiffing...") - (cvs-execute-list marked cvs-program (cons "diff" cvs-cvs-diff-flags))) - (message "cvsdiffing... Done.")) - - -(defun cvs-backup-diffable (tin cvs-buf) + ;; Don't care much about the exit status since it is the _sum_ of + ;; the status codes from the different files (not the _max_ as it + ;; should be). + (if (cvs-execute-list marked cvs-program + (if cvs-cvsroot + (cons "-d" (cons cvs-cvsroot + (cons "diff" cvs-diff-flags))) + (cons "diff" cvs-diff-flags))) + (message "cvsdiffing... Done.") + (message "cvsdiffing... No differences found.")))) + + +(defun cvs-backup-diffable (tin) "Check if the TIN is backup-diffable. It must have a backup file to be diffable." - (cvs-fileinfo->backup-file (cookie-cookie cvs-buf tin))) + (file-readable-p + (cvs-fileinfo->backup-file (tin-cookie cvs-cookie-handle tin)))) -(defun cvs-diff-backup () +(defun cvs-mode-diff-backup (&optional ignore-marks) "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. +If the variable cvs-diff-ignore-marks is non-nil any marked files will +not be considered to be selected. An optional prefix argument will +invert the influence from cvs-diff-ignore-marks. + The flags in cvs-diff-flags will be passed to ``diff''." - (interactive) + (interactive "P") + + (if (not (listp cvs-diff-flags)) + (error "cvs-diff-flags should be a list of strings.")) + (save-some-buffers) - (let ((marked (cvs-filter (function cvs-backup-diffable) - (cvs-get-marked) - (current-buffer)))) + (let ((marked (cvs-filter + (function cvs-backup-diffable) + (cvs-get-marked + (or + (and ignore-marks (not cvs-diff-ignore-marks)) + (and (not ignore-marks) cvs-diff-ignore-marks)))))) (if (null marked) (error "No ``Conflict'' or ``Merged'' file selected!")) (cvs-use-temp-buffer) @@ -1155,72 +1679,76 @@ The flags in cvs-diff-flags will be passed to ``diff''." (defun cvs-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." - (if (null (cvs-fileinfo->backup-file fileinfo)) + (if (not (file-readable-p (cvs-fileinfo->backup-file fileinfo))) (error "%s has no backup file." (concat (file-name-as-directory (cvs-fileinfo->dir fileinfo)) (cvs-fileinfo->file-name fileinfo)))) - (list (cvs-fileinfo->file-name fileinfo) - (cvs-fileinfo->backup-file fileinfo))) + (list (cvs-fileinfo->backup-file fileinfo) + (cvs-fileinfo->file-name fileinfo))) -(defun cvs-find-file-other-window (pos) +(defun cvs-mode-find-file-other-window (pos) "Select a buffer containing the file in another window. Args: POS" (interactive "d") - (save-some-buffers) - (let* ((cookie-last-tin - (cookie-get-selection (current-buffer) pos cookie-last-tin)) - (type (cvs-fileinfo->type (cookie-cookie (current-buffer) - cookie-last-tin)))) - (cond - ((or (eq type 'REMOVED) - (eq type 'CVS-REMOVED)) - (error "Can't visit a removed file.")) - ((eq type 'DIRCHANGE) - (let ((obuf (current-buffer)) - (odir default-directory)) - (setq default-directory - (file-name-as-directory - (cvs-fileinfo->dir - (cookie-cookie (current-buffer) cookie-last-tin)))) - (dired-other-window default-directory) - (set-buffer obuf) - (setq default-directory odir))) - (t - (find-file-other-window (cvs-full-path (current-buffer) - cookie-last-tin)))))) + (let ((tin (tin-locate cvs-cookie-handle pos))) + (if tin + (let ((type (cvs-fileinfo->type (tin-cookie cvs-cookie-handle + tin)))) + (cond + ((or (eq type 'REMOVED) + (eq type 'CVS-REMOVED)) + (error "Can't visit a removed file.")) + ((eq type 'DIRCHANGE) + (let ((obuf (current-buffer)) + (odir default-directory)) + (setq default-directory + (file-name-as-directory + (cvs-fileinfo->dir + (tin-cookie cvs-cookie-handle tin)))) + (dired-other-window default-directory) + (set-buffer obuf) + (setq default-directory odir))) + (t + (find-file-other-window (cvs-full-path tin))))) + (error "There is no file to find.")))) -(defun cvs-full-path (buffer tin) - "Return the full path for the file that is described in TIN. -Args: BUFFER TIN." +(defun cvs-fileinfo->full-path (fileinfo) + "Return the full path for the file that is described in FILEINFO." (concat (file-name-as-directory - (cvs-fileinfo->dir (cookie-cookie buffer tin))) - (cvs-fileinfo->file-name (cookie-cookie buffer tin)))) + (cvs-fileinfo->dir fileinfo)) + (cvs-fileinfo->file-name fileinfo))) -(defun cvs-find-file (pos) +(defun cvs-full-path (tin) + "Return the full path for the file that is described in TIN." + (cvs-fileinfo->full-path (tin-cookie cvs-cookie-handle tin))) + +(defun cvs-mode-find-file (pos) "Select a buffer containing the file in another window. Args: POS" (interactive "d") (let* ((cvs-buf (current-buffer)) - (cookie-last-tin (cookie-get-selection cvs-buf pos cookie-last-tin)) - (fileinfo (cookie-cookie cvs-buf cookie-last-tin)) - (type (cvs-fileinfo->type fileinfo))) - (cond - ((or (eq type 'REMOVED) - (eq type 'CVS-REMOVED)) - (error "Can't visit a removed file.")) - ((eq type 'DIRCHANGE) - (let ((odir default-directory)) - (setq default-directory - (file-name-as-directory (cvs-fileinfo->dir fileinfo))) - (dired default-directory) - (set-buffer cvs-buf) - (setq default-directory odir))) - (t - (find-file (cvs-full-path cvs-buf cookie-last-tin)))))) + (tin (tin-locate cvs-cookie-handle pos))) + (if tin + (let* ((fileinfo (tin-cookie cvs-cookie-handle tin)) + (type (cvs-fileinfo->type fileinfo))) + (cond + ((or (eq type 'REMOVED) + (eq type 'CVS-REMOVED)) + (error "Can't visit a removed file.")) + ((eq type 'DIRCHANGE) + (let ((odir default-directory)) + (setq default-directory + (file-name-as-directory (cvs-fileinfo->dir fileinfo))) + (dired default-directory) + (set-buffer cvs-buf) + (setq default-directory odir))) + (t + (find-file (cvs-full-path tin))))) + (error "There is no file to find.")))) -(defun cvs-mark-all-files () +(defun cvs-mode-mark-all-files () "Mark all files. Directories are not marked." (interactive) @@ -1229,16 +1757,15 @@ Directories are not marked." ((not (eq (cvs-fileinfo->type cookie) 'DIRCHANGE)) (cvs-set-fileinfo->marked cookie t) t)))) - (current-buffer))) + cvs-cookie-handle)) -(defun cvs-unmark (pos) +(defun cvs-mode-unmark (pos) "Unmark a fileinfo. Args: POS." (interactive "d") - (let* ((tin (cookie-get-selection - (current-buffer) pos cookie-last-tin)) - (sel (cookie-cookie (current-buffer) tin))) + (let* ((tin (tin-locate cvs-cookie-handle pos)) + (sel (tin-cookie cvs-cookie-handle tin))) (cond ((eq (cvs-fileinfo->type sel) 'DIRCHANGE) @@ -1248,14 +1775,14 @@ Directories are not marked." ((cvs-dir-member-p f dir) (cvs-set-fileinfo->marked f nil) t)))) - (current-buffer) + cvs-cookie-handle (cvs-fileinfo->dir sel))) (t (cvs-set-fileinfo->marked sel nil) - (cookie-invalidate-tins (current-buffer) tin) - (cookie-next-cookie (current-buffer) pos 1))))) + (tin-invalidate cvs-cookie-handle tin) + (tin-goto-next cvs-cookie-handle pos 1))))) -(defun cvs-unmark-all-files () +(defun cvs-mode-unmark-all-files () "Unmark all files. Directories are also unmarked, but that doesn't matter, since they should always be unmarked." @@ -1263,13 +1790,13 @@ they should always be unmarked." (cookie-map (function (lambda (cookie) (cvs-set-fileinfo->marked cookie nil) t)) - (current-buffer))) + cvs-cookie-handle)) -(defun cvs-do-removal (cvs-buf tins) +(defun cvs-do-removal (tins) "Remove files. -Args: CVS-BUF TINS. -CVS-BUF is the cvs buffer. TINS is a list of tins that the +Args: TINS. +TINS is a list of tins that the user wants to delete. The files are deleted. If the type of the tin is 'UNKNOWN the tin is removed from the buffer. If it is anything else the file is added to a list that should be @@ -1283,70 +1810,141 @@ Returns a list of tins files that should be `cvs remove'd." (let (files-to-remove) (while tins (let* ((tin (car tins)) - (fileinfo (cookie-cookie cvs-buf tin)) + (fileinfo (tin-cookie cvs-cookie-handle tin)) (type (cvs-fileinfo->type fileinfo))) (if (not (or (eq type 'REMOVED) (eq type 'CVS-REMOVED))) (progn - (delete-file (cvs-full-path cvs-buf tin)) + (delete-file (cvs-full-path tin)) (cond ((or (eq type 'UNKNOWN) (eq type 'MOVE-AWAY)) - (cookie-delete cvs-buf tin)) + (tin-delete cvs-cookie-handle tin)) (t (setq files-to-remove (cons tin files-to-remove)) (cvs-set-fileinfo->type fileinfo 'REMOVED) (cvs-set-fileinfo->handled fileinfo nil) - (cookie-invalidate-tins cvs-buf tin)))))) + (tin-invalidate cvs-cookie-handle tin)))))) (setq tins (cdr tins))) files-to-remove)) (t nil))) -(defun cvs-remove-file () +(defun cvs-mode-remove-file () "Remove all marked files." (interactive) - (let ((files-to-remove (cvs-do-removal (current-buffer) (cvs-get-marked)))) + (let ((files-to-remove (cvs-do-removal (cvs-get-marked)))) (if (null files-to-remove) nil (cvs-use-temp-buffer) (message "removing from repository...") - (cvs-execute-list files-to-remove cvs-program '("remove")) - (message "removing from repository... done.")))) - -(defun cvs-acknowledge () + (if (cvs-execute-list files-to-remove cvs-program + (if cvs-cvsroot + (list "-d" cvs-cvsroot "remove") + '("remove"))) + (error "CVS exited with non-zero exit status.") + (message "removing from repository... done."))))) + +(defun cvs-mode-undo-local-changes () + "Undo local changes to all marked files. +The file is removed and `cvs update FILE' is run." + (interactive) + (let ((tins-to-undo (cvs-get-marked))) + (cvs-use-temp-buffer) + (mapcar 'cvs-insert-full-path tins-to-undo) + (cond + ((and tins-to-undo (yes-or-no-p (format "Undo changes to %d files? " + (length tins-to-undo)))) + (let (files-to-update) + (while tins-to-undo + (let* ((tin (car tins-to-undo)) + (fileinfo (tin-cookie cvs-cookie-handle tin)) + (type (cvs-fileinfo->type fileinfo))) + (cond + ((or + (eq type 'UPDATED) (eq type 'MODIFIED) (eq type 'MERGED) + (eq type 'CONFLICT) (eq type 'CVS-REMOVED) + (eq type 'REM-CONFLICT) (eq type 'MOVE-AWAY) + (eq type 'REMOVED)) + (if (not (eq type 'REMOVED)) + (delete-file (cvs-full-path tin))) + (setq files-to-update (cons tin files-to-update)) + (cvs-set-fileinfo->type fileinfo 'UPDATED) + (cvs-set-fileinfo->handled fileinfo t) + (tin-invalidate cvs-cookie-handle tin)) + + ((eq type 'MOD-CONFLICT) + (error "Use cvs-mode-add instead on %s." + (cvs-fileinfo->file-name fileinfo))) + + ((eq type 'REM-CONFLICT) + (error "Can't deal with a file you have removed and recreated.")) + + ((eq type 'DIRCHANGE) + (error "Undo on directories not supported (yet).")) + + ((eq type 'ADDED) + (error "There is no old revision to get for %s" + (cvs-fileinfo->file-name fileinfo))) + (t (error "cvs-mode-undo-local-changes: can't handle an %s" + type))) + + (setq tins-to-undo (cdr tins-to-undo)))) + (cvs-use-temp-buffer) + (message "Regetting files from repository...") + (if (cvs-execute-list files-to-update cvs-program + (if cvs-cvsroot + (list "-d" cvs-cvsroot "update") + '("update"))) + (error "CVS exited with non-zero exit status.") + (message "Regetting files from repository... done."))))))) + +(defun cvs-mode-acknowledge () "Remove all marked files from the buffer." (interactive) (mapcar (function (lambda (tin) - (cookie-delete (current-buffer) tin))) - (cvs-get-marked)) - (setq cookie-last-tin nil)) + (tin-delete cvs-cookie-handle tin))) + (cvs-get-marked))) -(defun cvs-unmark-up (pos) +(defun cvs-mode-unmark-up (pos) "Unmark the file on the previous line. Takes one argument POS, a buffer position." (interactive "d") - (cookie-previous-cookie (current-buffer) pos 1) - (cvs-set-fileinfo->marked (cookie-cookie (current-buffer) cookie-last-tin) - nil) - (cookie-invalidate-tins (current-buffer) cookie-last-tin)) - -(defun cvs-add-file-update-buffer (cvs-buf tin) - "Subfunction to cvs-add. Internal use only. + (let ((tin (tin-goto-previous cvs-cookie-handle pos 1))) + (cond + (tin + (cvs-set-fileinfo->marked (tin-cookie cvs-cookie-handle tin) + nil) + (tin-invalidate cvs-cookie-handle tin))))) + +(defun cvs-mode-previous-line (arg) + "Go to the previous line. +If a prefix argument is given, move by that many lines." + (interactive "p") + (tin-goto-previous cvs-cookie-handle (point) arg)) + +(defun cvs-mode-next-line (arg) + "Go to the next line. +If a prefix argument is given, move by that many lines." + (interactive "p") + (tin-goto-next cvs-cookie-handle (point) arg)) + +(defun cvs-add-file-update-buffer (tin) + "Subfunction to cvs-mode-add. Internal use only. Update the display. Return non-nil if `cvs add' should be called on this -file. Args: CVS-BUF TIN. +file. Args: TIN. Returns 'ADD or 'RESURRECT." - (let ((fileinfo (cookie-cookie cvs-buf tin))) + (let ((fileinfo (tin-cookie cvs-cookie-handle tin))) (cond ((eq (cvs-fileinfo->type fileinfo) 'UNKNOWN) (cvs-set-fileinfo->type fileinfo 'ADDED) - (cookie-invalidate-tins cvs-buf tin) + (tin-invalidate cvs-cookie-handle tin) 'ADD) ((eq (cvs-fileinfo->type fileinfo) 'REMOVED) (cvs-set-fileinfo->type fileinfo 'UPDATED) (cvs-set-fileinfo->handled fileinfo t) - (cookie-invalidate-tins cvs-buf tin) + (tin-invalidate cvs-cookie-handle tin) 'RESURRECT)))) (defun cvs-add-sub (cvs-buf candidates) @@ -1357,7 +1955,7 @@ The first list is unknown tins that shall be `cvs add -m msg'ed. The second list is removed files that shall be `cvs add'ed (resurrected)." (let (add resurrect) (while candidates - (let ((type (cvs-add-file-update-buffer cvs-buf (car candidates)))) + (let ((type (cvs-add-file-update-buffer (car candidates)))) (cond ((eq type 'ADD) (setq add (cons (car candidates) add))) ((eq type 'RESURRECT) @@ -1365,7 +1963,7 @@ The second list is removed files that shall be `cvs add'ed (resurrected)." (setq candidates (cdr candidates))) (cons add resurrect))) -(defun cvs-add () +(defun cvs-mode-add () "Add marked files to the cvs repository." (interactive) @@ -1380,15 +1978,23 @@ The second list is removed files that shall be `cvs add'ed (resurrected)." (cond (resurrect (message "Resurrecting files from repository...") - (cvs-execute-list resurrect cvs-program '("add")) - (message "Done."))) + (if (cvs-execute-list resurrect cvs-program + (if cvs-cvsroot + (list "-d" cvs-cvsroot "add") + '("add"))) + (error "CVS exited with non-zero exit status.") + (message "Done.")))) (cond (added (message "Adding new files to repository...") - (cvs-execute-list added cvs-program (list "add" "-m" msg)) - (message "Done."))))) - -(defun cvs-ignore () + (if (cvs-execute-list added cvs-program + (if cvs-cvsroot + (list "-d" cvs-cvsroot "add" "-m" msg) + (list "add" "-m" msg))) + (error "CVS exited with non-zero exit status.") + (message "Done.")))))) + +(defun cvs-mode-ignore () "Arrange so that CVS ignores the selected files. This command ignores files that are not flagged as `Unknown'." (interactive) @@ -1396,12 +2002,12 @@ This command ignores files that are not flagged as `Unknown'." (mapcar (function (lambda (tin) (cond ((eq (cvs-fileinfo->type - (cookie-cookie (current-buffer) tin)) 'UNKNOWN) + (tin-cookie cvs-cookie-handle tin)) + 'UNKNOWN) (cvs-append-to-ignore - (cookie-cookie (current-buffer) tin)) - (cookie-delete (current-buffer) tin))))) - (cvs-get-marked)) - (setq cookie-last-tin nil)) + (tin-cookie cvs-cookie-handle tin)) + (tin-delete cvs-cookie-handle tin))))) + (cvs-get-marked))) (defun cvs-append-to-ignore (fileinfo) "Append the file in fileinfo to the .cvsignore file" @@ -1413,9 +2019,11 @@ This command ignores files that are not flagged as `Unknown'." (if (not (zerop (current-column))) (insert "\n")) (insert (cvs-fileinfo->file-name fileinfo) "\n") + (if cvs-sort-ignore-file + (sort-lines nil (point-min) (point-max))) (save-buffer))) -(defun cvs-status () +(defun cvs-mode-status () "Show cvs status for all marked files." (interactive) @@ -1423,26 +2031,45 @@ This command ignores files that are not flagged as `Unknown'." (let ((marked (cvs-get-marked))) (cvs-use-temp-buffer) (message "Running cvs status ...") - (cvs-execute-list marked cvs-program (cons "status" cvs-status-flags))) - (message "Running cvs status ... Done.")) - -(defun cvs-log () + (if (cvs-execute-list + marked cvs-program + (if cvs-cvsroot + (cons "-d" (cons cvs-cvsroot (cons "status" cvs-status-flags))) + (cons "status" cvs-status-flags))) + (error "CVS exited with non-zero exit status.") + (message "Running cvs status ... Done.")))) + +(defun cvs-mode-log () "Display the cvs log of all selected files." (interactive) (let ((marked (cvs-get-marked))) (cvs-use-temp-buffer) (message "Running cvs log ...") - (cvs-execute-list marked cvs-program (cons "log" cvs-log-flags))) - (message "Running cvs log ... Done.")) - + (if (cvs-execute-list marked cvs-program + (if cvs-cvsroot + (cons "-d" (cons cvs-cvsroot + (cons "log" cvs-log-flags))) + (cons "log" cvs-log-flags))) + (error "CVS exited with non-zero exit status.") + (message "Running cvs log ... Done.")))) + +(defun cvs-byte-compile-files () + "Run byte-compile-file on all selected files that end in '.el'." + (interactive) + (let ((marked (cvs-get-marked))) + (while marked + (let ((filename (cvs-full-path (car marked)))) + (if (string-match "\\.el$" filename) + (byte-compile-file filename))) + (setq marked (cdr marked))))) (defun cvs-insert-full-path (tin) - "Insert full path to the file described in TIN." - (insert (format "%s\n" (cvs-full-path cvs-buffer-name tin)))) + "Insert full path to the file described in TIN in the current buffer." + (insert (format "%s\n" (cvs-full-path tin)))) -(defun cvs-add-change-log-entry-other-window (pos) +(defun cvs-mode-add-change-log-entry-other-window (pos) "Add a ChangeLog entry in the ChangeLog of the current directory. Args: POS." (interactive "d") @@ -1451,9 +2078,9 @@ Args: POS." (setq default-directory (file-name-as-directory (cvs-fileinfo->dir - (cookie-cookie - cvs-buf - (cookie-get-selection cvs-buf pos cookie-last-tin))))) + (tin-cookie + cvs-cookie-handle + (tin-locate cvs-cookie-handle pos))))) (if (not default-directory) ;In case there was no entries. (setq default-directory odir)) (add-change-log-entry-other-window) @@ -1463,7 +2090,7 @@ Args: POS." (defun print-cvs-tin (foo) "Debug utility." - (let ((cookie (cookie-cookie (current-buffer) foo)) + (let ((cookie (tin-cookie cvs-cookie-handle foo)) (stream (get-buffer-create "debug"))) (princ "==============\n" stream) (princ (cvs-fileinfo->file-name cookie) stream) @@ -1474,3 +2101,106 @@ Args: POS." (princ "\n" stream) (princ (cvs-fileinfo->marked cookie) stream) (princ "\n" stream))) + +(defun cvs-mode-emerge (pos) + "Emerge appropriate revisions of the selected file. +Args: POS" + (interactive "d") + (let* ((cvs-buf (current-buffer)) + (tin (tin-locate cvs-cookie-handle pos))) + (if tin + (let* ((fileinfo (tin-cookie cvs-cookie-handle tin)) + (type (cvs-fileinfo->type fileinfo))) + (cond + ((eq type 'MODIFIED) + (require 'emerge) + (let ((tmp-file + (cvs-retrieve-revision-to-tmpfile fileinfo))) + (unwind-protect + (if (not (emerge-files + t + (cvs-fileinfo->full-path fileinfo) + tmp-file + (cvs-fileinfo->full-path fileinfo))) + (error "Emerge session failed")) + (delete-file tmp-file)))) + + ((or (eq type 'MERGED) + (eq type 'CONFLICT)) + (require 'emerge) + (let ((tmp-file + (cvs-retrieve-revision-to-tmpfile + fileinfo)) + (ancestor-file + (cvs-retrieve-revision-to-tmpfile + fileinfo + (cvs-fileinfo->base-revision fileinfo)))) + (unwind-protect + (if (not (emerge-files-with-ancestor + t + (cvs-fileinfo->backup-file fileinfo) + tmp-file + ancestor-file + (cvs-fileinfo->full-path fileinfo))) + (error "Emerge session failed")) + (delete-file tmp-file) + (delete-file ancestor-file)))) + (t + (error "Can only emerge \"Modified\", \"Merged\" or \"Conflict\"%s" + " files")))) + (error "There is no file to emerge.")))) + +(defun cvs-retrieve-revision-to-tmpfile (fileinfo &optional revision) + "Retrieve the latest revision of the file in FILEINFO to a temporary file. +If second optional argument REVISION is given, retrieve that revision instead." + (let + ((temp-name (make-temp-name + (concat (file-name-as-directory + (or (getenv "TMPDIR") "/tmp")) + "pcl-cvs." revision)))) + (cvs-kill-buffer-visiting temp-name) + (if revision + (message "Retrieving revision %s..." revision) + (message "Retrieving latest revision...")) + (let ((res (call-process cvs-shell nil nil nil "-c" + (concat cvs-program " update -p " + (if revision + (concat "-r " revision " ") + "") + (cvs-fileinfo->full-path fileinfo) + " > " temp-name)))) + (if (and res (not (and (integerp res) (zerop res)))) + (error "Something went wrong: %s" res)) + + (if revision + (message "Retrieving revision %s... Done." revision) + (message "Retrieving latest revision... Done.")) + (find-file-noselect temp-name) + temp-name))) + +(defun cvs-fileinfo->backup-file (fileinfo) + "Construct the file name of the backup file for FILEINFO." + (if (cvs-fileinfo->base-revision fileinfo) + (concat cvs-bakprefix (cvs-fileinfo->file-name fileinfo) + "." (cvs-fileinfo->base-revision fileinfo)))) + +(defun cvs-kill-buffer-visiting (filename) + "If there is any buffer visiting FILENAME, kill it (without confirmation)." + (let ((l (buffer-list))) + (while l + (if (string= (buffer-file-name (car l)) filename) + (kill-buffer (car l))) + (setq l (cdr l))))) + +(defun cvs-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?"))) + (setq cvs-cvsroot newroot))) + +(if (string-match "Lucid" emacs-version) + (progn + (autoload 'pcl-cvs-fontify "pcl-cvs-lucid") + (add-hook 'cvs-mode-hook 'pcl-cvs-fontify))) |
