mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-23 10:34:07 +00:00
* 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.
This commit is contained in:
Stefan Monnier
parent
ff1a0d8e5b
commit
cb3430a1f7
@ -1,5 +1,39 @@
|
||||
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-*-(message|file) and use easy-mmode-define-navigation.
|
||||
(log-view-message-re): Match SCCS format as well.
|
||||
|
||||
@ -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 @@ BUT if it is the header or the footer in EWOC return nil instead."
|
||||
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 @@ consume any more resources."
|
||||
(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 @@ insert-before-markers.
|
||||
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 @@ arguments will be passed to MAP-FUNCTION."
|
||||
(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 @@ If the EWOC is empty, nil is returned."
|
||||
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 @@ will be called for all elements in EWOC.
|
||||
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 @@ Returns nil if the buffer has been deleted."
|
||||
(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)
|
||||
|
||||
|
||||
@ -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 @@ This variable is buffer local and only used in the *cvs* buffer.")
|
||||
;;;; 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 @@ It is expected to call the function.")
|
||||
(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
|
||||
|
||||
@ -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 confuse some users sometimes."
|
||||
;; 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 @@ For use by the cookie package."
|
||||
'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 @@ For use by the cookie package."
|
||||
;; 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 @@ fileinfo will appear first, followed by all files (alphabetically)."
|
||||
(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)
|
||||
|
||||
@ -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 @@ Match RE and if successful, execute MATCHES."
|
||||
(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 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
|
||||
(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.*$")
|
||||
|
||||
@ -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 @@ The SEPARATOR regexp defaults to \"\\s-+\"."
|
||||
(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
|
||||
|
||||
205
lisp/pcvs.el
205
lisp/pcvs.el
@ -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
|
||||
;; ******** 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).
|
||||
;;
|
||||
;; ** 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 @@ If non-nil, NEW means to create a new buffer no matter what."
|
||||
(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 @@ If non-nil, NEW means to create a new buffer no matter what."
|
||||
"\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 @@ If non-nil, NEW means to create a new buffer no matter what."
|
||||
(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 @@ the override will persist until the next toggle."
|
||||
|
||||
;;----------
|
||||
(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 @@ Pcl-cvs runs `pcl-cvs-load-hook' after being loaded."
|
||||
(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 @@ Signal an error if there is no backup file."
|
||||
(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 @@ DONT-CHANGE-DISC non-nil indicates that the command will not change the
|
||||
contents of files. This is only used by the parser.
|
||||
POSTPROC is a list of expressions to be evaluated at the very end (after
|
||||
parsing if applicable). It will be prepended with `progn' is necessary."
|
||||
(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))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user