Re: Connection to emacs CVS broken ?

[ttn]

   From: Richard Stallman <address@hidden>
   Date: Fri, 16 Mar 2007 01:21:39 -0400

   It is important to commit each change with its specific change log
   entry.  Don't do a mass commit!

below is some elisp that does ,v file "unparsing".  it was omitted from
vc-rcs.el changes related to vc-annotate support for RCS since i didn't
think it would be useful.  however, in this case, we can use it to write
new ,v files directly, after a "tree append" operation.  something like:

 (let* ((old (vc-rcs-parse (find-file "OLD,v")))
        (new (vc-rcs-parse (find-file "NEW,v")))
        (merged (APPEND-NEW-ENTRIES old new)))
   (set-buffer (generate-new-buffer "GEN,v"))
   (erase-buffer)
   (comma-v-unparse merged)
   (write-file "GEN,v"))

someone would have to write APPEND-NEW-ENTRIES, of course, but at least
that can be done more at the semantic level...

note that verification by a human will still be needed, in any case.

thi

____________________________________________________________
(defun comma-v-unparse (tree &optional buffer)
  "Insert TREE into current buffer in RCS-style masterfile format.
Optional second arg BUFFER specifies another buffer to insert into.
You can use `comma-v-parse' to get TREE."
  (setq buffer (get-buffer (or buffer (current-buffer))))
  (let ((standard-output buffer)
        (headers (cdr (assq 'headers tree)))
        (revisions (cdr (assq 'revisions tree))))
    (flet ((spew! (look name finish &optional proc)
                  (princ name)
                  (let ((v (funcall (or proc 'identity)
                                    (funcall look name))))
                    (unless (string= "" v)
                      (unless proc
                        (princ "\t"))
                      (princ v)))
                  (princ ";") (princ finish)))
      (flet ((hspew (name finish &optional proc)
                    (spew! (lambda (name) (cdr (assq name headers)))
                           name finish proc)))
        (hspew 'head "\n")
        (when (assq 'branch headers)
          (hspew 'branch "\n"))
        (hspew 'access "\n")
        (hspew 'symbols "\n" (lambda (ls)
                               (apply 'concat
                                      (mapcar (lambda (x)
                                                (format "\n\t%s:%s"
                                                        (car x) (cdr x)))
                                              ls))))
        (hspew 'locks " ")
        (hspew 'strict "\n")
        (hspew 'comment "\n\n\n" (lambda (s) (format "address@hidden@" s))))
      (dolist (rev revisions)
        (princ (car rev))
        (princ "\n")
        (flet ((rlook (name) (cdr (assq name (cdr rev))))
               (rspew (name finish &optional proc)
                      (spew! 'rlook name finish proc)))
          (rspew 'date "\t" (lambda (v)
                              (format-time-string "\t%Y.%m.%d.%H.%M.%S" v)))
          (rspew 'author "\t" (lambda (v) (concat " " v)))
          (rspew 'state "\n" (lambda (v) (concat " " v)))
          (rspew 'branches "\n")
          (rspew 'next "\n\n"))))
    (princ "\n")
    (flet ((spew! (look name finish &optional proc)
                  (princ name)
                  (princ "\n@")
                  (princ (with-temp-buffer
                           (insert (funcall (or proc 'identity)
                                            (funcall look name)))
                           (while (search-backward "@" (point-min) t)
                             (insert "@") (forward-char -1))
                           (buffer-string)))
                  (princ "@\n") (princ finish)))
      (spew! (lambda (name) (cdr (assq name headers))) 'desc "")
      (dolist (rev revisions)
        (princ "\n\n") (princ (car rev)) (princ "\n")
        (flet ((rlook (name) (cdr (assq name (cdr rev)))))
          (spew! 'rlook 'log "")
          (spew! (if (assq :insn (cdr rev))
                     (let ((s (with-temp-buffer
                                (dolist (cmd (nreverse (rlook :insn)))
                                  (case (cadr cmd)
                                    (k (insert (format "d%d %d\n"
                                                       (car cmd)
                                                       (caddr cmd))))
                                    (i (insert (format "a%d "
                                                       (1- (car cmd))))
                                       (save-excursion
                                         (insert (caddr cmd)))
                                       (insert (format "%d\n"
                                                       (count-lines
                                                        (point) (point-max))))
                                       (goto-char (point-max)))))
                                (buffer-string))))
                       `(lambda (x) ,s))
                   'rlook)
                 'text ""))))))