Mercurial > emacs
changeset 28256:06cfa273543d
* pcvs.el: Add a minimal leading commentary.
(cvs-make-cvs-buffer): Change the header part by removing the startup
message and adding a `Module' entry. Also replace the FOOTER and
HEADER special fileinfos with the new support in ewoc for updating
its own footer and header.
(cvs-update-header): Update to use the header/footer of the ewoc.
(cvs-mode): Use define-derived-mode and set truncate-lines to t.
(cvs-is-within-p): New function.
(cvs-mode-run): Take advantage of `save-some-buffers's new ability
to only examine some subset of the buffers.
* pcvs-info.el (cvs-fileinfo-pp): Use the new property-preserving
`format' instead of our own ad-hoc functions.
Remove HEADER and FOOTER cases, now handled in the EWOC.
(cvs-fileinfo<): Remove HEADER and FOOTER cases.
* pcvs-parse.el (cvs-parse-run-table): Change message for unknown
output to avoid scaring the user.
(cvs-parse-table): Catch message for non-up-to-date commits.
* pcvs-defs.el (cvs-startup-message): Remove.
(cvs-global-menu): New autoloaded menu.
* pcvs-util.el (cvs-string-fill): Remove.
* emacs-lisp/ewoc.el (ewoc--create-special-node): Remove.
(ewoc--refresh-node): Don't take the whole EWOC but only the relevant
PP part of it and also make it work for footers and headers.
(ewoc-create): Drop POS and BUFFER arguments.
Use the DLL's dummy node to store the end-of-footer position.
(ewoc-map, ewoc-invalidate): Update call to ewoc--refresh-node.
(ewoc-refresh): Remove unused `header' variable.
(ewoc-(get|set)-hf): New functions.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Wed, 22 Mar 2000 02:57:01 +0000 |
| parents | 0f3c283ff1b0 |
| children | 1f09d55c62d2 |
| files | lisp/emacs-lisp/ewoc.el lisp/pcvs-defs.el lisp/pcvs-info.el lisp/pcvs-parse.el lisp/pcvs-util.el lisp/pcvs.el |
| diffstat | 6 files changed, 153 insertions(+), 227 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/emacs-lisp/ewoc.el Wed Mar 22 01:58:18 2000 +0000 +++ b/lisp/emacs-lisp/ewoc.el Wed Mar 22 02:57:01 2000 +0000 @@ -68,7 +68,6 @@ ;; certain point in a certain buffer. (The buffer and point are ;; fixed when the ewoc is created). The header and the footer ;; are constant strings. They appear before and after the elements. -;; (Currently, once set, they can not be changed). ;; ;; Ewoc does not affect the mode of the buffer in any way. It ;; merely makes it easy to connect an underlying data representation @@ -94,7 +93,7 @@ ;; In the mean time `grep '^(.*ewoc-[^-]' emacs-lisp/ewoc.el' can help ;; you find all the exported functions: ;; -;; (defun ewoc-create (buffer pretty-printer &optional header footer pos) +;; (defun ewoc-create (pretty-printer &optional header footer) ;; (defalias 'ewoc-data 'ewoc--node-data) ;; (defun ewoc-enter-first (ewoc data) ;; (defun ewoc-enter-last (ewoc data) @@ -113,7 +112,8 @@ ;; (defun ewoc-refresh (ewoc) ;; (defun ewoc-collect (ewoc predicate &rest args) ;; (defun ewoc-buffer (ewoc) - +;; (defun ewoc-get-hf (ewoc) +;; (defun ewoc-set-hf (ewoc header footer) ;; Coding conventions ;; ================== @@ -234,27 +234,6 @@ node)) -(defun ewoc--create-special-node (data string pos) - "Insert STRING at POS in current buffer. Remember the start -position. Create a wrapper containing that start position and the -element DATA." - (save-excursion - ;; Remember the position as a number so that it doesn't move - ;; when we insert the string. - (when (markerp pos) (setq pos (marker-position pos))) - (goto-char pos) - (let ((inhibit-read-only t)) - ;; Use insert-before-markers so that the marker for the - ;; next element is updated. - (insert-before-markers string) - ;; Always insert a newline. You want invisible elements? You - ;; lose. (At least in this version). FIXME-someday. (It is - ;; harder to fix than it might seem. All markers have to point - ;; to the right place all the time...) - (insert-before-markers ?\n) - (ewoc--node-create (copy-marker pos) data)))) - - (defun ewoc--create-node (data pretty-printer pos) "Call PRETTY-PRINTER with point set at POS in current buffer. Remember the start position. Create a wrapper containing that @@ -293,32 +272,26 @@ (ewoc--node-delete node))) -(defvar dll) ;passed by dynamic binding - -(defun ewoc--refresh-node (ewoc node) - "Redisplay the element represented by NODE. -Can not be used on the footer. dll *must* be bound to -\(ewoc--dll ewoc)." +(defun ewoc--refresh-node (pp node) + "Redisplay the element represented by NODE using the pretty-printer PP." (let ((inhibit-read-only t)) (save-excursion ;; First, remove the string from the buffer: (delete-region (ewoc--node-start-marker node) (1- (marker-position - (ewoc--node-start-marker (ewoc--node-next dll node))))) + (ewoc--node-start-marker (ewoc--node-right node))))) ;; Calculate and insert the string. (goto-char (ewoc--node-start-marker node)) - (funcall (ewoc--pretty-printer ewoc) - (ewoc--node-data node))))) + (funcall pp (ewoc--node-data node))))) ;;; =========================================================================== ;;; Public members of the Ewoc package -(defun ewoc-create (buffer pretty-printer &optional header footer pos) +(defun ewoc-create (pretty-printer &optional header footer) "Create an empty ewoc. -The ewoc will be inserted in BUFFER. BUFFER may be a -buffer or a buffer name. It is created if it does not exist. +The ewoc will be inserted in the current buffer at the current position. PRETTY-PRINTER should be a function that takes one argument, an element, and inserts a string representing it in the buffer (at @@ -330,27 +303,22 @@ Optional third argument HEADER is a string that will always be present at the top of the ewoc. HEADER should end with a newline. Optionaly fourth argument FOOTER is similar, and will -always be inserted at the bottom of the ewoc. - -Optional fifth argument POS is a buffer position, specifying -where the ewoc will be inserted. It defaults to the -beginning of the buffer." +be inserted at the bottom of the ewoc." (let ((new-ewoc - (ewoc--create (get-buffer-create buffer) - pretty-printer nil nil (ewoc--dll-create)))) + (ewoc--create (current-buffer) + pretty-printer nil nil (ewoc--dll-create))) + (pos (point))) (ewoc--set-buffer-bind-dll new-ewoc ;; Set default values (unless header (setq header "")) (unless footer (setq footer "")) - (unless pos (setq pos (point-min))) - ;; Force header to be above footer. - (if (markerp pos) (setq pos (marker-position pos))) - (let ((foot (ewoc--create-special-node footer footer pos)) - (head (ewoc--create-special-node header header pos))) + (setf (ewoc--node-start-marker dll) (copy-marker pos)) + (let ((foot (ewoc--create-node footer (lambda (x) (insert footer)) pos)) + (head (ewoc--create-node header (lambda (x) (insert header)) pos))) (ewoc--node-enter-first dll head) (ewoc--node-enter-last dll foot) - (setf (ewoc--header new-ewoc) (ewoc--node-nth dll 0)) - (setf (ewoc--footer new-ewoc) (ewoc--node-nth dll -1)))) + (setf (ewoc--header new-ewoc) head) + (setf (ewoc--footer new-ewoc) foot))) ;; Return the ewoc new-ewoc)) @@ -427,7 +395,7 @@ (node (ewoc--node-nth dll 1))) (while (not (eq node footer)) (if (apply map-function (ewoc--node-data node) args) - (ewoc--refresh-node ewoc node)) + (ewoc--refresh-node (ewoc--pretty-printer ewoc) node)) (setq node (ewoc--node-next dll node))))) (defun ewoc-filter (ewoc predicate &rest args) @@ -521,7 +489,7 @@ The pretty-printer that for EWOC will be called for all NODES." (ewoc--set-buffer-bind-dll ewoc (dolist (node nodes) - (ewoc--refresh-node ewoc node)))) + (ewoc--refresh-node (ewoc--pretty-printer ewoc) node)))) (defun ewoc-goto-prev (ewoc pos arg) "Move point to the ARGth previous element. @@ -566,8 +534,7 @@ Note that `ewoc-invalidate' is more efficient if only a small number of elements needs to be refreshed." (ewoc--set-buffer-bind-dll-let* ewoc - ((header (ewoc--header ewoc)) - (footer (ewoc--footer ewoc))) + ((footer (ewoc--footer ewoc))) (let ((inhibit-read-only t)) (delete-region (ewoc--node-start-marker (ewoc--node-nth dll 1)) (ewoc--node-start-marker footer)) @@ -609,6 +576,18 @@ (let ((buf (ewoc--buffer ewoc))) (when (buffer-name buf) buf))) +(defun ewoc-get-hf (ewoc) + "Return a cons cell containing the (HEADER . FOOTER) of EWOC." + (cons (ewoc--node-data (ewoc--header ewoc)) + (ewoc--node-data (ewoc--footer ewoc)))) + +(defun ewoc-set-hf (ewoc header footer) + "Set the HEADER and FOOTER of EWOC." + (setf (ewoc--node-data (ewoc--header ewoc)) header) + (setf (ewoc--node-data (ewoc--footer ewoc)) footer) + (ewoc--refresh-node (lambda (x) (insert header)) (ewoc--header ewoc)) + (ewoc--refresh-node (lambda (x) (insert footer)) (ewoc--footer ewoc))) + (provide 'ewoc)
--- a/lisp/pcvs-defs.el Wed Mar 22 01:58:18 2000 +0000 +++ b/lisp/pcvs-defs.el Wed Mar 22 02:57:01 2000 +0000 @@ -5,7 +5,7 @@ ;; Author: Stefan Monnier <monnier@cs.yale.edu> ;; Keywords: pcl-cvs ;; Version: $Name: $ -;; Revision: $Id: pcvs-defs.el,v 1.1 2000/03/11 03:42:29 monnier Exp $ +;; Revision: $Id: pcvs-defs.el,v 1.2 2000/03/15 21:28:58 gerd Exp $ ;; This file is part of GNU Emacs. @@ -294,10 +294,6 @@ ;;;; Global internal variables ;;;; -(defconst cvs-startup-message - (concat "PCL-CVS release " pcl-cvs-version) - "*Startup message for CVS.") - (defconst cvs-vendor-branch "1.1.1" "The default branch used by CVS for vendor code.") @@ -460,17 +456,25 @@ (defconst cvs-pcl-cvs-dirchange-re "^pcl-cvs: descending directory \\(.*\\)$") ;;;; -;;;; +;;;; autoload the global menu ;;;; -(if (progn (condition-case () (require 'easymenu) (error nil)) - (fboundp 'easy-menu-add-item)) - (easy-menu-add-item nil '("tools") - '("PCL CVS" - ["Update Directory" cvs-update t] - ["Examine Directory" cvs-examine t] - ["Status Directory" cvs-status t] - ["Checkout Module" cvs-checkout t]) "vc")) +;;;###autoload +(defvar cvs-global-menu + (let ((m (make-sparse-keymap "PCL-CVS"))) + (define-key m [status] + '(menu-item "Directory Status" cvs-status + :help "A more verbose status of a workarea")) + (define-key m [checkout] + '(menu-item "Checkout Module" cvs-checkout + :help "Check out a module from the repository")) + (define-key m [update] + '(menu-item "Update Directory" cvs-update + :help "Fetch updates from the repository")) + (define-key m [examine] + '(menu-item "Examine Directory" cvs-examine + :help "Examine the current state of a workarea")) + m)) ;; cvs-1.10 and above can take file arguments in other directories
--- a/lisp/pcvs-info.el Wed Mar 22 01:58:18 2000 +0000 +++ b/lisp/pcvs-info.el Wed Mar 22 02:57:01 2000 +0000 @@ -5,7 +5,7 @@ ;; Author: Stefan Monnier <monnier@cs.yale.edu> ;; Keywords: pcl-cvs ;; Version: $Name: $ -;; Revision: $Id: pcl-cvs-info.el,v 1.28 2000/03/05 21:32:21 monnier Exp $ +;; Revision: $Id: pcvs-info.el,v 1.1 2000/03/11 03:42:29 monnier Exp $ ;; This file is part of GNU Emacs. @@ -212,8 +212,6 @@ ;; to display a text that should be in ;; full-log." ;; TEMP A temporary message that should be removed - ;; HEADER A message that should stick at the top of the display - ;; FOOTER A message that should stick at the bottom of the display ) (defun cvs-create-fileinfo (type dir file msg &rest keys) (cvs-check-fileinfo (apply #'-cvs-create-fileinfo type dir file msg keys))) @@ -362,10 +360,8 @@ 'cvs-header-face cvs-dirname-map) ":")) (MESSAGE - (if (memq (cvs-fileinfo->subtype fileinfo) '(FOOTER HEADER)) - (cvs-fileinfo->full-log fileinfo) - (cvs-add-face (format "Message: %s" (cvs-fileinfo->full-log fileinfo)) - 'cvs-msg-face))) + (cvs-add-face (format "Message: %s" (cvs-fileinfo->full-log fileinfo)) + 'cvs-msg-face)) (t (let* ((status (if (cvs-fileinfo->marked fileinfo) (cvs-add-face "*" 'cvs-marked-face) @@ -390,24 +386,9 @@ ;; or the head-rev (when (and head (not (string= head base))) head) ;; or nothing - "")) - ;; (action (cvs-add-face (case (cvs-default-action fileinfo) - ;; (commit "com") - ;; (update "upd") - ;; (undo "udo") - ;; (t " ")) - ;; 'cvs-action-face - ;; cvs-action-map)) - ) - (concat (cvs-string-fill side 11) " " - status " " - (cvs-string-fill type 11) " " - ;; action " " - (cvs-string-fill base 11) " " - file))))))) -;; it seems that `format' removes text-properties. Too bad! -;; (format "%-11s %s %-11s %-11s %s" -;; side status type base file))))))) + ""))) + (format "%-11s %s %-11s %-11s %s" + side status type base file))))))) (defun cvs-fileinfo-update (fi fi-new) @@ -433,12 +414,6 @@ (let ((subtypea (cvs-fileinfo->subtype a)) (subtypeb (cvs-fileinfo->subtype b))) (cond - ;; keep header and footer where they belong. Note: the order is important - ((eq subtypeb 'HEADER) nil) - ((eq subtypea 'HEADER) t) - ((eq subtypea 'FOOTER) nil) - ((eq subtypeb 'FOOTER) t) - ;; Sort according to directories. ((string< (cvs-fileinfo->dir a) (cvs-fileinfo->dir b)) t) ((not (string= (cvs-fileinfo->dir a) (cvs-fileinfo->dir b))) nil)
--- a/lisp/pcvs-parse.el Wed Mar 22 01:58:18 2000 +0000 +++ b/lisp/pcvs-parse.el Wed Mar 22 02:57:01 2000 +0000 @@ -5,7 +5,7 @@ ;; Author: Stefan Monnier <monnier@cs.yale.edu> ;; Keywords: pcl-cvs ;; Version: $Name: $ -;; Revision: $Id: pcl-cvs-parse.el,v 1.41 2000/03/05 21:32:21 monnier Exp $ +;; Revision: $Id: pcvs-parse.el,v 1.1 2000/03/11 03:42:29 monnier Exp $ ;; This file is part of GNU Emacs. @@ -154,7 +154,7 @@ (and (cvs-match ".*$") (cvs-create-fileinfo 'MESSAGE cvs-current-dir " " - (concat " Parser Error: '" (cvs-parse-msg) "'") + (concat " Unknown msg: '" (cvs-parse-msg) "'") :subtype 'ERROR))))) @@ -318,6 +318,10 @@ (and (cvs-match "use `.+ add' to create an entry for \\(.*\\)$" (path 1)) (cvs-parsed-fileinfo 'UNKNOWN path)) + ;; [commit] + (and (cvs-match "Up-to-date check failed for `\\(.+\\)'$" (file 1)) + (cvs-parsed-fileinfo 'NEED-MERGE file)) + ;; We use cvs-execute-multi-dir but cvs can't handle it ;; Probably because the cvs-client can but the cvs-server can't (and (cvs-match ".* files with '?/'? in their name.*$")
--- a/lisp/pcvs-util.el Wed Mar 22 01:58:18 2000 +0000 +++ b/lisp/pcvs-util.el Wed Mar 22 02:57:01 2000 +0000 @@ -5,7 +5,7 @@ ;; Author: Stefan Monnier <monnier@cs.yale.edu> ;; Keywords: pcl-cvs ;; Version: $Name: $ -;; Revision: $Id: pcvs-util.el,v 1.1 2000/03/11 03:42:30 monnier Exp $ +;; Revision: $Id: pcvs-util.el,v 1.2 2000/03/17 10:07:00 fx Exp $ ;; This file is part of GNU Emacs. @@ -189,15 +189,6 @@ (let ((rfs (read-from-string string i))) (cons (car rfs) (cvs-string->strings (substring string (cdr rfs)) sep))))))) - - -(defun cvs-string-fill (str n &optional filling truncate) - "Add FILLING (defaults to the space char) to STR to reach size N. -If STR is longer than N, truncate if TRUNCATE is set, else don't do anything." - (let ((l (length str))) - (if (> l n) - (if truncate (substring str 0 n) str) - (concat str (make-string (- n l) (or filling ? )))))) ;;;; ;;;; file names
--- a/lisp/pcvs.el Wed Mar 22 01:58:18 2000 +0000 +++ b/lisp/pcvs.el Wed Mar 22 02:57:01 2000 +0000 @@ -14,7 +14,7 @@ ;; Maintainer: (Stefan Monnier) monnier+lists/cvs/pcl@flint.cs.yale.edu ;; Keywords: CVS, version control, release management ;; Version: $Name: $ -;; Revision: $Id: pcl-cvs.el,v 1.75 2000/03/05 21:32:21 monnier Exp $ +;; Revision: $Id: pcvs.el,v 1.1 2000/03/11 03:42:30 monnier Exp $ ;; This file is part of GNU Emacs. @@ -35,105 +35,78 @@ ;;; 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 used to be a TeXinfo manual, but it's now so out of date that +;; it's not even worth looking at it. + ;;; Todo: -;; * FIX THE DOCUMENTATION -;; -;; * Emacs-21 adaptation -;; ** use the new arg of save-some-buffers -;; ** add toolbar entries -;; ** use `format' now that it keeps properties -;; ** use propertize -;; ** add compatibility with older name's variables. -;; -;; * New Features -;; -;; ** marking -;; *** marking directories should jump to just after the dir. -;; *** allow (un)marking directories at a time with the mouse. -;; *** marking with the mouse should not move point. -;; -;; ** liveness indicator -;; -;; ** indicate in docstring if the cmd understands the `b' prefix(es). +;; ******** FIX THE DOCUMENTATION ********* ;; -;; ** call smerge-mode when opening CONFLICT files. -;; -;; ** after-parse-hook (to eliminate *.elc from Emacs' CVS repository :-) -;; -;; ** 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 +;; - write cvs-fast-examine that parses CVS/Entries instead of running cvs +;; we could even steal code from vc-cvs-hooks for that. +;; - add toolbar entries +;; - marking +;; marking directories should jump to just after the dir. +;; allow (un)marking directories at a time with the mouse. +;; marking with the mouse should not move point. +;; - liveness indicator +;; - indicate in docstring if the cmd understands the `b' prefix(es). +;; - call smerge-mode when opening CONFLICT files. +;; - after-parse-hook (to eliminate *.elc from Emacs' CVS repository :-) +;; - 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 +;; cvs-export ;; (with completion on tag names and hooks to ;; help generate full releases) -;; -;; ** allow cvs-cmd-do to either clear the marks or not. -;; -;; ** allow more concurrency: if the output buffer is busy, pick a new one. -;; -;; ** configurable layout/format of *cvs*. -;; -;; ** display stickiness information. And current CVS/Tag as well. -;; -;; ** cvs-log-mode should know how to extract version info -;; cvs-log-current-tag is a nop right now :-( -;; -;; ** write 'cvs-mode-admin' to do arbitrary 'cvs admin' commands -;; -;; ** cvs-mode-incorporate +;; - allow cvs-cmd-do to either clear the marks or not. +;; - allow more concurrency: if the output buffer is busy, pick a new one. +;; - display stickiness information. And current CVS/Tag as well. +;; - write 'cvs-mode-admin' to do arbitrary 'cvs admin' commands +;; - 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. +;; - 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. +;; - make `cvs-mode-ignore' allow manually entering a pattern. ;; to which dir should it apply ? -;; -;; ** cvs-mode-ignore should try to remove duplicate entries. -;; -;; * Old misfeatures -;; -;; ** cvs-mode-<foo> commands tend to require saving too many buffers -;; they should only require saving the files concerned by the command -;; -;; * Secondary issues -;; -;; ** maybe poll/check CVS/Entries files to react to external `cvs' commands ? -;; -;; ** some kind of `cvs annotate' support ? +;; - 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. -;; -;; * probably not worth the trouble -;; -;; ** dynamic `g' mapping +;; - dynamic `g' mapping ;; Make 'g', and perhaps other commands, use either cvs-update or ;; cvs-examine depending on the read-only status of the cvs buffer, for ;; instance. -;; -;; ** add message-levels so that we can hide some levels of messages +;; - add message-levels so that we can hide some levels of messages ;;; Code: @@ -457,24 +430,18 @@ (setq default-directory dir) (setq buffer-read-only nil) (erase-buffer) + (insert "\ +Repository : " (directory-file-name (cvs-get-cvsroot)) " +Module : " (cvs-get-module) " +Working dir: " (abbreviate-file-name dir) " + +") (setq buffer-read-only t) (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 - buffer 'cvs-fileinfo-pp - (format "%s\n\nRepository : %s\nWorking directory: %s\n" - cvs-startup-message - (directory-file-name (cvs-get-cvsroot)) - dir)))) + (let ((cookies (ewoc-create 'cvs-fileinfo-pp "\n" ""))) (set (make-local-variable 'cvs-cookies) cookies) - (ewoc-enter-first - cookies - (cvs-create-fileinfo 'MESSAGE "" " " "\n" :subtype 'HEADER)) - (ewoc-enter-last - cookies - (cvs-create-fileinfo 'MESSAGE "" " " "\n" :subtype 'FOOTER)) (make-local-hook 'kill-buffer-hook) (add-hook 'kill-buffer-hook (lambda () @@ -599,14 +566,8 @@ "\n"))) (if nil (insert str) ;inline ;;(with-current-buffer cvs-buffer - (let* ((tin0 (ewoc-nth cvs-cookies 0)) - (tin-1 (ewoc-nth cvs-cookies -1)) - (header (ewoc-data tin0)) - (footer (ewoc-data tin-1)) - (prev-msg (cvs-fileinfo->full-log header)) - (tin tin0)) - (assert (and (eq 'HEADER (cvs-fileinfo->subtype header)) - (eq 'FOOTER (cvs-fileinfo->subtype footer)))) + (let* ((prev-msg (car (ewoc-get-hf cvs-cookies))) + (tin (ewoc-nth cvs-cookies 0))) ;; look for the first *real* fileinfo (to determine emptyness) (while (and tin @@ -621,13 +582,11 @@ (match-string 1 prev-msg) " --"))) ;; set the new header and footer - (setf (cvs-fileinfo->full-log header) str) - (setf (cvs-fileinfo->full-log footer) - (concat "\n--------------------- " - (if tin "End" "Empty") - " ---------------------\n" - prev-msg)) - (ewoc-invalidate cvs-cookies tin0 tin-1)))));;) + (ewoc-set-hf cvs-cookies + str (concat "\n--------------------- " + (if tin "End" "Empty") + " ---------------------\n" + prev-msg)))))) ;;---------- @@ -999,10 +958,9 @@ ;;---------- (put 'cvs-mode 'mode-class 'special) -(easy-mmode-define-derived-mode cvs-mode fundamental-mode "CVS" +(define-derived-mode cvs-mode fundamental-mode "CVS" "Mode used for PCL-CVS, a frontend to CVS. -Full documentation is in the Texinfo file. -Pcl-cvs runs `pcl-cvs-load-hook' after being loaded." +Full documentation is in the Texinfo file." (setq mode-line-process '("" cvs-force-command cvs-ignore-marks-modif ":" (cvs-branch-prefix @@ -1012,6 +970,7 @@ (buffer-disable-undo (current-buffer)) ;;(set (make-local-variable 'goal-column) cvs-cursor-column) (set (make-local-variable 'revert-buffer-function) 'cvs-mode-revert-buffer) + (setq truncate-lines t) (cvs-prefix-make-local 'cvs-branch-prefix) (cvs-prefix-make-local 'cvs-secondary-branch-prefix) (cvs-prefix-make-local 'cvs-force-command) @@ -1578,6 +1537,18 @@ (setf (cvs-fileinfo->type fi) 'DEAD)) (setf (cvs-fileinfo->type fi) 'DEAD))) +(defun cvs-is-within-p (fis dir) + "Non-nil is buffer is inside one of FIS (in DIR)." + (when (stringp buffer-file-name) + (setq buffer-file-name (expand-file-name buffer-file-name)) + (let (ret) + (dolist (fi (or fis (list (cvs-create-fileinfo 'DIRCHANGE "" "." "")))) + (when (cvs-string-prefix-p + (expand-file-name (cvs-fileinfo->full-path fi) dir) + buffer-file-name) + (setq ret t))) + ret))) + (defun* cvs-mode-run (cmd flags fis &key (buf (cvs-temp-buffer)) dont-change-disc cvsargs postproc) @@ -1588,7 +1559,9 @@ 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." - (save-some-buffers) + (let ((def-dir default-directory)) + ;; Save the relevant buffers + (save-some-buffers nil (lambda () (cvs-is-within-p fis def-dir)))) (unless (listp flags) (error "flags should be a list of strings")) (let* ((cvs-buf (current-buffer)) (single-dir (or (not (listp cvs-execute-single-dir))