mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-11 16:08:13 +00:00
Code Issues Releases Activity

* pcvs.el: Add a minimal leading commentary.

Browse Source 
(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.
This commit is contained in:
Stefan Monnier 2000-03-22 02:57:23 +00:00
parent ff1a0d8e5b
commit cb3430a1f7
7 changed files with 187 additions and 227 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
lisp/ChangeLog
View File

@ -1,5 +1,39 @@
2000-03-21 Stefan Monnier <monnier@cs.yale.edu> 2000-03-21 Stefan Monnier <monnier@cs.yale.edu>
* 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.
* log-view.el (log-view-(msg|file)-(prev|next)): Rename from * log-view.el (log-view-(msg|file)-(prev|next)): Rename from
log-view-*-(message|file) and use easy-mmode-define-navigation. log-view-*-(message|file) and use easy-mmode-define-navigation.
(log-view-message-re): Match SCCS format as well. (log-view-message-re): Match SCCS format as well.

87
lisp/emacs-lisp/ewoc.el
View File

@ -68,7 +68,6 @@
;; certain point in a certain buffer. (The buffer and point are ;; certain point in a certain buffer. (The buffer and point are
;; fixed when the ewoc is created). The header and the footer ;; fixed when the ewoc is created). The header and the footer
;; are constant strings. They appear before and after the elements. ;; 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 ;; Ewoc does not affect the mode of the buffer in any way. It
;; merely makes it easy to connect an underlying data representation ;; 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 ;; In the mean time `grep '^(.*ewoc-[^-]' emacs-lisp/ewoc.el' can help
;; you find all the exported functions: ;; 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) ;; (defalias 'ewoc-data 'ewoc--node-data)
;; (defun ewoc-enter-first (ewoc data) ;; (defun ewoc-enter-first (ewoc data)
;; (defun ewoc-enter-last (ewoc data) ;; (defun ewoc-enter-last (ewoc data)
@ -113,7 +112,8 @@
;; (defun ewoc-refresh (ewoc) ;; (defun ewoc-refresh (ewoc)
;; (defun ewoc-collect (ewoc predicate &rest args) ;; (defun ewoc-collect (ewoc predicate &rest args)
;; (defun ewoc-buffer (ewoc) ;; (defun ewoc-buffer (ewoc)
;; (defun ewoc-get-hf (ewoc)
;; (defun ewoc-set-hf (ewoc header footer)
;; Coding conventions ;; Coding conventions
;; ================== ;; ==================
@ -234,27 +234,6 @@ BUT if it is the header or the footer in EWOC return nil instead."
node)) 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) (defun ewoc--create-node (data pretty-printer pos)
"Call PRETTY-PRINTER with point set at POS in current buffer. "Call PRETTY-PRINTER with point set at POS in current buffer.
Remember the start position. Create a wrapper containing that Remember the start position. Create a wrapper containing that
@ -293,32 +272,26 @@ consume any more resources."
(ewoc--node-delete node))) (ewoc--node-delete node)))
(defvar dll) ;passed by dynamic binding (defun ewoc--refresh-node (pp node)
"Redisplay the element represented by NODE using the pretty-printer PP."
(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)."
(let ((inhibit-read-only t)) (let ((inhibit-read-only t))
(save-excursion (save-excursion
;; First, remove the string from the buffer: ;; First, remove the string from the buffer:
(delete-region (ewoc--node-start-marker node) (delete-region (ewoc--node-start-marker node)
(1- (marker-position (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. ;; Calculate and insert the string.
(goto-char (ewoc--node-start-marker node)) (goto-char (ewoc--node-start-marker node))
(funcall (ewoc--pretty-printer ewoc) (funcall pp (ewoc--node-data node)))))
(ewoc--node-data node)))))
;;; =========================================================================== ;;; ===========================================================================
;;; Public members of the Ewoc package ;;; 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. "Create an empty ewoc.
The ewoc will be inserted in BUFFER. BUFFER may be a The ewoc will be inserted in the current buffer at the current position.
buffer or a buffer name. It is created if it does not exist.
PRETTY-PRINTER should be a function that takes one argument, an PRETTY-PRINTER should be a function that takes one argument, an
element, and inserts a string representing it in the buffer (at element, and inserts a string representing it in the buffer (at
@ -330,27 +303,22 @@ insert-before-markers.
Optional third argument HEADER is a string that will always be Optional third argument HEADER is a string that will always be
present at the top of the ewoc. HEADER should end with a present at the top of the ewoc. HEADER should end with a
newline. Optionaly fourth argument FOOTER is similar, and will newline. Optionaly fourth argument FOOTER is similar, and will
always be inserted at the bottom of the ewoc. 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."
(let ((new-ewoc (let ((new-ewoc
(ewoc--create (get-buffer-create buffer) (ewoc--create (current-buffer)
pretty-printer nil nil (ewoc--dll-create)))) pretty-printer nil nil (ewoc--dll-create)))
(pos (point)))
(ewoc--set-buffer-bind-dll new-ewoc (ewoc--set-buffer-bind-dll new-ewoc
;; Set default values ;; Set default values
(unless header (setq header "")) (unless header (setq header ""))
(unless footer (setq footer "")) (unless footer (setq footer ""))
(unless pos (setq pos (point-min))) (setf (ewoc--node-start-marker dll) (copy-marker pos))
;; Force header to be above footer. (let ((foot (ewoc--create-node footer (lambda (x) (insert footer)) pos))
(if (markerp pos) (setq pos (marker-position pos))) (head (ewoc--create-node header (lambda (x) (insert header)) pos)))
(let ((foot (ewoc--create-special-node footer footer pos))
(head (ewoc--create-special-node header header pos)))
(ewoc--node-enter-first dll head) (ewoc--node-enter-first dll head)
(ewoc--node-enter-last dll foot) (ewoc--node-enter-last dll foot)
(setf (ewoc--header new-ewoc) (ewoc--node-nth dll 0)) (setf (ewoc--header new-ewoc) head)
(setf (ewoc--footer new-ewoc) (ewoc--node-nth dll -1)))) (setf (ewoc--footer new-ewoc) foot)))
;; Return the ewoc ;; Return the ewoc
new-ewoc)) new-ewoc))
@ -427,7 +395,7 @@ arguments will be passed to MAP-FUNCTION."
(node (ewoc--node-nth dll 1))) (node (ewoc--node-nth dll 1)))
(while (not (eq node footer)) (while (not (eq node footer))
(if (apply map-function (ewoc--node-data node) args) (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))))) (setq node (ewoc--node-next dll node)))))
(defun ewoc-filter (ewoc predicate &rest args) (defun ewoc-filter (ewoc predicate &rest args)
@ -521,7 +489,7 @@ If the EWOC is empty, nil is returned."
The pretty-printer that for EWOC will be called for all NODES." The pretty-printer that for EWOC will be called for all NODES."
(ewoc--set-buffer-bind-dll ewoc (ewoc--set-buffer-bind-dll ewoc
(dolist (node nodes) (dolist (node nodes)
(ewoc--refresh-node ewoc node)))) (ewoc--refresh-node (ewoc--pretty-printer ewoc) node))))
(defun ewoc-goto-prev (ewoc pos arg) (defun ewoc-goto-prev (ewoc pos arg)
"Move point to the ARGth previous element. "Move point to the ARGth previous element.
@ -566,8 +534,7 @@ will be called for all elements in EWOC.
Note that `ewoc-invalidate' is more efficient if only a small Note that `ewoc-invalidate' is more efficient if only a small
number of elements needs to be refreshed." number of elements needs to be refreshed."
(ewoc--set-buffer-bind-dll-let* ewoc (ewoc--set-buffer-bind-dll-let* ewoc
((header (ewoc--header ewoc)) ((footer (ewoc--footer ewoc)))
(footer (ewoc--footer ewoc)))
(let ((inhibit-read-only t)) (let ((inhibit-read-only t))
(delete-region (ewoc--node-start-marker (ewoc--node-nth dll 1)) (delete-region (ewoc--node-start-marker (ewoc--node-nth dll 1))
(ewoc--node-start-marker footer)) (ewoc--node-start-marker footer))
@ -609,6 +576,18 @@ Returns nil if the buffer has been deleted."
(let ((buf (ewoc--buffer ewoc))) (let ((buf (ewoc--buffer ewoc)))
(when (buffer-name buf) buf))) (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) (provide 'ewoc)

32
lisp/pcvs-defs.el
View File

@ -5,7 +5,7 @@
;; Author: Stefan Monnier <monnier@cs.yale.edu> ;; Author: Stefan Monnier <monnier@cs.yale.edu>
;; Keywords: pcl-cvs ;; Keywords: pcl-cvs
;; Version: $Name: $ ;; 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. ;; This file is part of GNU Emacs.
@ -294,10 +294,6 @@ This variable is buffer local and only used in the *cvs* buffer.")
;;;; Global internal variables ;;;; 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" (defconst cvs-vendor-branch "1.1.1"
"The default branch used by CVS for vendor code.") "The default branch used by CVS for vendor code.")
@ -460,17 +456,25 @@ It is expected to call the function.")
(defconst cvs-pcl-cvs-dirchange-re "^pcl-cvs: descending directory \\(.*\\)$") (defconst cvs-pcl-cvs-dirchange-re "^pcl-cvs: descending directory \\(.*\\)$")
;;;; ;;;;
;;;; ;;;; autoload the global menu
;;;; ;;;;
(if (progn (condition-case () (require 'easymenu) (error nil)) ;;;###autoload
(fboundp 'easy-menu-add-item)) (defvar cvs-global-menu
(easy-menu-add-item nil '("tools") (let ((m (make-sparse-keymap "PCL-CVS")))
'("PCL CVS" (define-key m [status]
["Update Directory" cvs-update t] '(menu-item "Directory Status" cvs-status
["Examine Directory" cvs-examine t] :help "A more verbose status of a workarea"))
["Status Directory" cvs-status t] (define-key m [checkout]
["Checkout Module" cvs-checkout t]) "vc")) '(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 ;; cvs-1.10 and above can take file arguments in other directories

35
lisp/pcvs-info.el
View File

@ -5,7 +5,7 @@
;; Author: Stefan Monnier <monnier@cs.yale.edu> ;; Author: Stefan Monnier <monnier@cs.yale.edu>
;; Keywords: pcl-cvs ;; Keywords: pcl-cvs
;; Version: $Name: $ ;; 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. ;; This file is part of GNU Emacs.
@ -212,8 +212,6 @@ to confuse some users sometimes."
;; to display a text that should be in ;; to display a text that should be in
;; full-log." ;; full-log."
;; TEMP A temporary message that should be removed ;; 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) (defun cvs-create-fileinfo (type dir file msg &rest keys)
(cvs-check-fileinfo (apply #'-cvs-create-fileinfo type dir file msg keys))) (cvs-check-fileinfo (apply #'-cvs-create-fileinfo type dir file msg keys)))
@ -362,10 +360,8 @@ For use by the cookie package."
'cvs-header-face cvs-dirname-map) 'cvs-header-face cvs-dirname-map)
":")) ":"))
(MESSAGE (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-add-face (format "Message: %s" (cvs-fileinfo->full-log fileinfo))
'cvs-msg-face))) 'cvs-msg-face))
(t (t
(let* ((status (if (cvs-fileinfo->marked fileinfo) (let* ((status (if (cvs-fileinfo->marked fileinfo)
(cvs-add-face "*" 'cvs-marked-face) (cvs-add-face "*" 'cvs-marked-face)
@ -390,24 +386,9 @@ For use by the cookie package."
;; or the head-rev ;; or the head-rev
(when (and head (not (string= head base))) head) (when (and head (not (string= head base))) head)
;; or nothing ;; or nothing
"")) "")))
;; (action (cvs-add-face (case (cvs-default-action fileinfo) (format "%-11s %s %-11s %-11s %s"
;; (commit "com") side status type base file)))))))
;; (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)))))))
(defun cvs-fileinfo-update (fi fi-new) (defun cvs-fileinfo-update (fi fi-new)
@ -433,12 +414,6 @@ fileinfo will appear first, followed by all files (alphabetically)."
(let ((subtypea (cvs-fileinfo->subtype a)) (let ((subtypea (cvs-fileinfo->subtype a))
(subtypeb (cvs-fileinfo->subtype b))) (subtypeb (cvs-fileinfo->subtype b)))
(cond (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. ;; Sort according to directories.
((string< (cvs-fileinfo->dir a) (cvs-fileinfo->dir b)) t) ((string< (cvs-fileinfo->dir a) (cvs-fileinfo->dir b)) t)
((not (string= (cvs-fileinfo->dir a) (cvs-fileinfo->dir b))) nil) ((not (string= (cvs-fileinfo->dir a) (cvs-fileinfo->dir b))) nil)

8
lisp/pcvs-parse.el
View File

@ -5,7 +5,7 @@
;; Author: Stefan Monnier <monnier@cs.yale.edu> ;; Author: Stefan Monnier <monnier@cs.yale.edu>
;; Keywords: pcl-cvs ;; Keywords: pcl-cvs
;; Version: $Name: $ ;; 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. ;; This file is part of GNU Emacs.
@ -154,7 +154,7 @@ Match RE and if successful, execute MATCHES."
(and (and
(cvs-match ".*$") (cvs-match ".*$")
(cvs-create-fileinfo 'MESSAGE cvs-current-dir " " (cvs-create-fileinfo 'MESSAGE cvs-current-dir " "
(concat " Parser Error: '" (cvs-parse-msg) "'") (concat " Unknown msg: '" (cvs-parse-msg) "'")
:subtype 'ERROR))))) :subtype 'ERROR)))))
@ -318,6 +318,10 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
(and (cvs-match "use `.+ add' to create an entry for \\(.*\\)$" (path 1)) (and (cvs-match "use `.+ add' to create an entry for \\(.*\\)$" (path 1))
(cvs-parsed-fileinfo 'UNKNOWN path)) (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 ;; We use cvs-execute-multi-dir but cvs can't handle it
;; Probably because the cvs-client can but the cvs-server can't ;; Probably because the cvs-client can but the cvs-server can't
(and (cvs-match ".* files with '?/'? in their name.*$") (and (cvs-match ".* files with '?/'? in their name.*$")

11
lisp/pcvs-util.el
View File

@ -5,7 +5,7 @@
;; Author: Stefan Monnier <monnier@cs.yale.edu> ;; Author: Stefan Monnier <monnier@cs.yale.edu>
;; Keywords: pcl-cvs ;; Keywords: pcl-cvs
;; Version: $Name: $ ;; 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. ;; This file is part of GNU Emacs.
@ -190,15 +190,6 @@ The SEPARATOR regexp defaults to \"\\s-+\"."
(cons (car rfs) (cons (car rfs)
(cvs-string->strings (substring string (cdr rfs)) sep))))))) (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 ;;;; file names
;;;; ;;;;

201
lisp/pcvs.el
View File

@ -14,7 +14,7 @@
;; Maintainer: (Stefan Monnier) monnier+lists/cvs/pcl@flint.cs.yale.edu ;; Maintainer: (Stefan Monnier) monnier+lists/cvs/pcl@flint.cs.yale.edu
;; Keywords: CVS, version control, release management ;; Keywords: CVS, version control, release management
;; Version: $Name: $ ;; 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. ;; This file is part of GNU Emacs.
@ -35,105 +35,78 @@
;;; Commentary: ;;; 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: ;;; Todo:
;; * FIX THE DOCUMENTATION ;; ******** FIX THE DOCUMENTATION *********
;; ;;
;; * Emacs-21 adaptation ;; - write cvs-fast-examine that parses CVS/Entries instead of running cvs
;; ** use the new arg of save-some-buffers ;; we could even steal code from vc-cvs-hooks for that.
;; ** add toolbar entries ;; - add toolbar entries
;; ** use `format' now that it keeps properties ;; - marking
;; ** use propertize ;; marking directories should jump to just after the dir.
;; ** add compatibility with older name's variables. ;; allow (un)marking directories at a time with the mouse.
;; ;; marking with the mouse should not move point.
;; * New Features ;; - liveness indicator
;; ;; - indicate in docstring if the cmd understands the `b' prefix(es).
;; ** marking ;; - call smerge-mode when opening CONFLICT files.
;; *** marking directories should jump to just after the dir. ;; - after-parse-hook (to eliminate *.elc from Emacs' CVS repository :-)
;; *** allow (un)marking directories at a time with the mouse. ;; - have vc-checkin delegate to cvs-mode-commit when applicable
;; *** marking with the mouse should not move point. ;; - higher-level CVS operations
;; ;; cvs-mode-rename
;; ** liveness indicator ;; cvs-mode-branch
;; ;; - module-level commands
;; ** indicate in docstring if the cmd understands the `b' prefix(es). ;; add support for parsing 'modules' file ("cvs co -c")
;; ;; cvs-mode-rcs2log
;; ** call smerge-mode when opening CONFLICT files. ;; cvs-rdiff
;; ;; cvs-release
;; ** after-parse-hook (to eliminate *.elc from Emacs' CVS repository :-) ;; cvs-import
;; ;; C-u M-x cvs-checkout should ask for a cvsroot
;; ** have vc-checkin delegate to cvs-mode-commit when applicable ;; cvs-mode-handle-new-vendor-version
;;
;; ** 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 ;; - checks out module, or alternately does update join
;; - does "cvs -n tag LAST_VENDOR" to find old files into *cvs* ;; - does "cvs -n tag LAST_VENDOR" to find old files into *cvs*
;; ;; cvs-export
;; *** cvs-export
;; (with completion on tag names and hooks to ;; (with completion on tag names and hooks to
;; help generate full releases) ;; help generate full releases)
;; ;; - allow cvs-cmd-do to either clear the marks or not.
;; ** 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.
;; ** allow more concurrency: if the output buffer is busy, pick a new one. ;; - write 'cvs-mode-admin' to do arbitrary 'cvs admin' commands
;; ;; - cvs-mode-incorporate
;; ** 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
;; It would merge in the status from one ``*cvs*'' buffer into another. ;; 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 ;; This would be used to populate such a buffer that had been created with
;; a `cvs {update,status,checkout} -l'. ;; a `cvs {update,status,checkout} -l'.
;; ;; - cvs-mode-(i)diff-other-{file,buffer,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.
;;
;; ** offer the choice to kill the process when the user kills the cvs buffer.
;; right now, it's killed without further ado. ;; 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 ? ;; to which dir should it apply ?
;; ;; - cvs-mode-ignore should try to remove duplicate entries.
;; ** 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 ?
;; * 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 ?
;; but vc-annotate can be used instead. ;; but vc-annotate can be used instead.
;; ;; - dynamic `g' mapping
;; * probably not worth the trouble
;;
;; ** dynamic `g' mapping
;; Make 'g', and perhaps other commands, use either cvs-update or ;; Make 'g', and perhaps other commands, use either cvs-update or
;; cvs-examine depending on the read-only status of the cvs buffer, for ;; cvs-examine depending on the read-only status of the cvs buffer, for
;; instance. ;; 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: ;;; Code:
@ -457,24 +430,18 @@ If non-nil, NEW means to create a new buffer no matter what."
(setq default-directory dir) (setq default-directory dir)
(setq buffer-read-only nil) (setq buffer-read-only nil)
(erase-buffer) (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) (setq buffer-read-only t)
(cvs-mode) (cvs-mode)
(set (make-local-variable 'list-buffers-directory) buffer-name) (set (make-local-variable 'list-buffers-directory) buffer-name)
;;(set (make-local-variable 'cvs-temp-buffer) (cvs-temp-buffer)) ;;(set (make-local-variable 'cvs-temp-buffer) (cvs-temp-buffer))
(let ((cookies (let ((cookies (ewoc-create 'cvs-fileinfo-pp "\n" "")))
(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))))
(set (make-local-variable 'cvs-cookies) cookies) (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) (make-local-hook 'kill-buffer-hook)
(add-hook 'kill-buffer-hook (add-hook 'kill-buffer-hook
(lambda () (lambda ()
@ -599,14 +566,8 @@ If non-nil, NEW means to create a new buffer no matter what."
"\n"))) "\n")))
(if nil (insert str) ;inline (if nil (insert str) ;inline
;;(with-current-buffer cvs-buffer ;;(with-current-buffer cvs-buffer
(let* ((tin0 (ewoc-nth cvs-cookies 0)) (let* ((prev-msg (car (ewoc-get-hf cvs-cookies)))
(tin-1 (ewoc-nth cvs-cookies -1)) (tin (ewoc-nth cvs-cookies 0)))
(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))))
;; look for the first *real* fileinfo (to determine emptyness) ;; look for the first *real* fileinfo (to determine emptyness)
(while (while
(and tin (and tin
@ -621,13 +582,11 @@ If non-nil, NEW means to create a new buffer no matter what."
(match-string 1 prev-msg) (match-string 1 prev-msg)
" --"))) " --")))
;; set the new header and footer ;; set the new header and footer
(setf (cvs-fileinfo->full-log header) str) (ewoc-set-hf cvs-cookies
(setf (cvs-fileinfo->full-log footer) str (concat "\n--------------------- "
(concat "\n--------------------- "
(if tin "End" "Empty") (if tin "End" "Empty")
" ---------------------\n" " ---------------------\n"
prev-msg)) prev-msg))))))
(ewoc-invalidate cvs-cookies tin0 tin-1)))));;)
;;---------- ;;----------
@ -999,10 +958,9 @@ the override will persist until the next toggle."
;;---------- ;;----------
(put 'cvs-mode 'mode-class 'special) (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. "Mode used for PCL-CVS, a frontend to CVS.
Full documentation is in the Texinfo file. Full documentation is in the Texinfo file."
Pcl-cvs runs `pcl-cvs-load-hook' after being loaded."
(setq mode-line-process (setq mode-line-process
'("" cvs-force-command cvs-ignore-marks-modif '("" cvs-force-command cvs-ignore-marks-modif
":" (cvs-branch-prefix ":" (cvs-branch-prefix
@ -1012,6 +970,7 @@ Pcl-cvs runs `pcl-cvs-load-hook' after being loaded."
(buffer-disable-undo (current-buffer)) (buffer-disable-undo (current-buffer))
;;(set (make-local-variable 'goal-column) cvs-cursor-column) ;;(set (make-local-variable 'goal-column) cvs-cursor-column)
(set (make-local-variable 'revert-buffer-function) 'cvs-mode-revert-buffer) (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-branch-prefix)
(cvs-prefix-make-local 'cvs-secondary-branch-prefix) (cvs-prefix-make-local 'cvs-secondary-branch-prefix)
(cvs-prefix-make-local 'cvs-force-command) (cvs-prefix-make-local 'cvs-force-command)
@ -1578,6 +1537,18 @@ Signal an error if there is no backup file."
(setf (cvs-fileinfo->type fi) 'DEAD)) (setf (cvs-fileinfo->type fi) 'DEAD))
(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 (defun* cvs-mode-run (cmd flags fis
&key (buf (cvs-temp-buffer)) &key (buf (cvs-temp-buffer))
dont-change-disc cvsargs postproc) dont-change-disc cvsargs postproc)
@ -1588,7 +1559,9 @@ DONT-CHANGE-DISC non-nil indicates that the command will not change the
contents of files. This is only used by the parser. contents of files. This is only used by the parser.
POSTPROC is a list of expressions to be evaluated at the very end (after 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." 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")) (unless (listp flags) (error "flags should be a list of strings"))
(let* ((cvs-buf (current-buffer)) (let* ((cvs-buf (current-buffer))
(single-dir (or (not (listp cvs-execute-single-dir)) (single-dir (or (not (listp cvs-execute-single-dir))