From: Thien-Thi Nguyen <ttn@glug.org>
Subject: Re: patch for documentation about version control
Date: 10 Nov 2004 11:43:33 -0500 [thread overview]
Message-ID: <jkr7n14pu2.fsf@glug.org> (raw)
In-Reply-To: Andre Spiegel's message of "Wed, 10 Nov 2004 10:22:36 +0100"
Andre Spiegel <spiegel@gnu.org> writes:
Please don't add this. RCS is perfectly alive and kicking, and to add
an alternative means of manipulating the master files (with subtle
incompatibilities admitted) is just plain unnecessary.
If you can use your parsing functions to make vc-annotate work under
RCS, that is a fine improvement, but please (a) let me see your patches
before you commit them, and (b) version control operations on RCS files
should always go via the actual RCS commands.
the patch is appended. for the curious, there is also version 2.0.1 of
comma-v.el, from which the patch originated, in dir:
http://www.glug.org/people/ttn/software/ttn-pers-elisp/standalone/
as you can see, the patch does not actually change anything currently
defined in vc-rcs.el; it is purely additive. btw, ORIG => 1.41. if
there is a better way to get a file's per-line version info w/o parsing
the masterfile, please let me know in the next few days. otherwise, i
will commit this so that vc-annotate is supported for RCS.
we can always ask the RCS maintainers to provide such info to Emacs in
the future (if we care), w/o being constrained by its present lack.
thi
____________________________________
diff -c vc-rcs.el.ORIG vc-rcs.el
*** vc-rcs.el.ORIG Wed Nov 10 17:00:47 2004
--- vc-rcs.el Wed Nov 10 17:35:19 2004
***************
*** 497,502 ****
--- 497,608 ----
(and newvers (concat "-r" newvers)))
(vc-switches 'RCS 'diff))))
+ (defun vc-rcs-annotate-command (file buffer &optional revision)
+ "Annotate FILE, inserting the results in BUFFER.
+ Optional arg REVISION is a revision to annotate from."
+ (let* ((tree (with-temp-buffer
+ (insert-file-contents (vc-rcs-registered file))
+ (vc-rcs-parse)))
+ (headers (cdr (assq 'headers tree)))
+ (revisions (cdr (assq 'revisions tree)))
+ (cur (cdr (assq 'head headers)))
+ (rbit (assoc cur revisions))
+ (meta (cdr rbit))
+ path pre delayed opp)
+ (unless revision
+ (setq revision cur))
+ (unless (assoc revision revisions)
+ (error "No such revision: %s" revision))
+ (set-buffer buffer)
+ ;; korg
+ (insert (cdr (assq 'text meta)))
+ (while (when (setq pre cur cur (cdr (assq 'next meta)))
+ (not (string= "" cur)))
+ (setq meta (cdr (assoc cur revisions))
+ opp nil
+ delayed nil)
+ (dolist (insn (cdr (assq :insn meta)))
+ (goto-line (pop insn))
+ (let ((p (point)))
+ (case (pop insn)
+ (k (push (let ((s (buffer-substring-no-properties
+ p (progn (forward-line (car insn))
+ (point)))))
+ `(,p ,(length s) I ,s))
+ delayed))
+ (i (push (let ((s (car insn)))
+ `(,p ,s K ,(length s)))
+ delayed)))))
+ (dolist (p-act-ract (sort delayed (lambda (a b) (> (car a) (car b)))))
+ (let* ((p (pop p-act-ract))
+ (act (pop p-act-ract)))
+ (push (cons p p-act-ract) opp)
+ (goto-char p)
+ (funcall (if (numberp act)
+ 'delete-char
+ 'insert)
+ act)))
+ (when (or path (string= revision pre))
+ (push `((:pre . ,pre)
+ (:opp . ,opp)
+ ,@meta)
+ path)))
+ (push `((:pre . ,pre)
+ (:opp . ((1 I ,(buffer-substring-no-properties
+ (point-min) (point-max)))))
+ ,@meta)
+ path)
+ (erase-buffer)
+ ;; grok
+ (flet ((r/d/a (ls) (let ((r (cdr (assq :pre ls))))
+ (let ((pre-ls (cdr (assoc r revisions))))
+ (vector r
+ (cdr (assq 'date pre-ls))
+ (cdr (assq 'author pre-ls)))))))
+ (dolist (rbit path)
+ (dolist (insn (cdr (assq :opp rbit)))
+ (goto-char (pop insn))
+ (case (pop insn)
+ (I (insert (propertize (car insn)
+ :vc-rcs-r/d/a (r/d/a rbit)
+ 'front-sticky '(:vc-rcs-r/d/a)
+ 'rear-nonsticky t)))
+ (K (delete-char (car insn))))))))
+ ;; decorate
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let ((r/d/a (get-text-property (point) :vc-rcs-r/d/a)))
+ (insert-and-inherit
+ ;; cvs envy (for now -- usurpers enjoy the dish best served cold)
+ (format "%-12s (%-8s %s): " ; see `vc-rcs-annotate-time'
+ (aref r/d/a 0)
+ (aref r/d/a 2)
+ (format-time-string "%d-%b-%y" (aref r/d/a 1)))))
+ (forward-line 1)))
+
+ (defun vc-rcs-annotate-current-time ()
+ "Return the current time, based at midnight of the current day, and
+ encoded as fractional days."
+ (vc-annotate-convert-time
+ (apply 'encode-time 0 0 0 (nthcdr 3 (decode-time (current-time))))))
+
+ (defun vc-rcs-annotate-time ()
+ "Return the time of the next annotation (as fraction of days)
+ systime, or nil if there is none. Also, reposition point."
+ (unless (eobp)
+ (forward-char ; see `vc-rcs-annotate-command'
+ (+ 12 ; revision
+ 2 ; space + left paren
+ 8 ; author
+ 1 ; space
+ (+ 2 1 3 1 2) ; date
+ 3)) ; right paren + colon + space
+ (vc-annotate-convert-time
+ (aref (get-text-property (point) :vc-rcs-r/d/a) 1))))
+
+ (defun vc-rcs-annotate-extract-revision-at-line ()
+ (aref (get-text-property (point) :vc-rcs-r/d/a) 0))
+
\f
;;;
;;; Snapshot system
***************
*** 784,789 ****
--- 890,1126 ----
(defun vc-rcs-set-default-branch (file branch)
(vc-do-command nil 0 "rcs" (vc-name file) (concat "-b" branch))
(vc-file-setprop file 'vc-rcs-default-branch branch))
+
+ (defun vc-rcs-parse (&optional buffer)
+ ;; Parse current buffer, presumed to be in RCS-style masterfile format.
+ ;; Optional arg BUFFER specifies another buffer to parse. Return an alist
+ ;; of two elements, w/ keys `headers' and `revisions' and values in turn
+ ;; sub-alists. For `headers', the values unless otherwise specified are
+ ;; strings and the keys are:
+ ;;
+ ;; desc -- description
+ ;; head -- latest revision
+ ;; access -- ???
+ ;; symbols -- sub-alist of (SYMBOL . REVISION) elements
+ ;; locks -- if file is checked out, something like "ttn:1.7"
+ ;; strict -- ???
+ ;; comment -- typically something like "# " or "; "
+ ;;
+ ;; For `revisions', the car is REVISION (string), the cdr a sub-alist,
+ ;; with string values (unless otherwise specified) and keys:
+ ;;
+ ;; date -- a time value (like that returned by `encode-time'); as a
+ ;; special case, a year value less than 100 is augmented by 1900
+ ;; author -- username
+ ;; state -- typically "Exp" or "Rel"
+ ;; branches -- ???
+ ;; next -- next revision (which is actually prior in time!)
+ ;; log -- change log entry
+ ;; text -- for the head revision, this is the body of the file;
+ ;; other revisions have `:insn' instead
+ ;; :insn -- for non-head revisions, a list of parsed instructions
+ ;; in one of two forms, in both cases START meaning "first
+ ;; go to line START":
+ ;; - `(START k COUNT)' -- kill COUNT lines
+ ;; - `(START i TEXT)' -- insert TEXT (a string)
+ ;;
+ ;; The `:insn' key is a keyword to distinguish it as a vc-rcs.el value-added
+ ;; extra crispy not-found-in-stores bonus.
+ (setq buffer (get-buffer (or buffer (current-buffer))))
+ (set-buffer buffer)
+ (let (start context tok headers desc revs)
+ (setq start (point))
+ (goto-char (point-min))
+ (flet ((sw () (skip-chars-forward "[:space:]"))
+ (to-eol () (buffer-substring (point) (progn (forward-line 1)
+ (1- (point)))))
+ (to-semi () (buffer-substring (point) (progn (search-forward ";")
+ (1- (point)))))
+ (to-one@ () (buffer-substring
+ (progn (search-forward "@") (point))
+ (progn (while (and (search-forward "@")
+ (= ?@ (char-after))
+ (progn (forward-char 1) t)))
+ (1- (point)))))
+ (tok+val (src name &optional proc)
+ (if (not (eq name (setq tok (read buffer))))
+ (error "Missing `%s' while parsing %s" name context)
+ (sw)
+ (cons tok (funcall (or proc 'identity)
+ (funcall src)))))
+ (k-semi (name &optional proc) (tok+val 'to-semi name proc))
+ (k-one@ (name &optional proc) (tok+val 'to-one@ name proc))
+ (@<-@@ (s) (with-temp-buffer
+ (insert s)
+ (while (search-backward "@@" (point-min) t)
+ (delete-char 1))
+ (buffer-string))))
+ ;; headers
+ (setq context 'headers)
+ (flet ((hpush (name &optional proc)
+ (push (k-semi name proc) headers)))
+ (mapc 'hpush '(head access))
+ (hpush 'symbols
+ (lambda (x)
+ (mapcar (lambda (together)
+ (let ((two (split-string together ":")))
+ (setcar two (intern (car two)))
+ (setcdr two (cadr two))
+ two))
+ (split-string x))))
+ (mapc 'hpush '(locks strict)))
+ (push (tok+val ; ugh
+ (lambda ()
+ (unless (looking-at "@")
+ (error "Malformed `comment' header"))
+ (forward-char 1)
+ (buffer-substring
+ (point) (progn (search-forward "@;")
+ (- (point) 2))))
+ 'comment)
+ headers)
+ (setq headers (nreverse headers))
+ ;; rev headers
+ (sw) (setq context 'rev-headers)
+ (while (looking-at "[0-9]")
+ (push `(,(to-eol)
+ ,(k-semi 'date
+ (lambda (s)
+ (apply 'encode-time
+ (let ((ls (mapcar 'string-to-number
+ (split-string s "\\."))))
+ ;; hack the year -- verified to be the
+ ;; same algorithm used in RCS 5.7
+ (when (< (car ls) 100)
+ (setcar ls (+ 1900 (car ls))))
+ (reverse ls)))))
+ ,@(mapcar 'k-semi '(author state branches next)))
+ revs)
+ (sw))
+ (setq revs (nreverse revs))
+ ;; desc
+ (sw) (setq context 'desc
+ desc (k-one@ 'desc '@<-@@))
+ ;; rev bodies
+ (dolist (rev revs)
+ (sw)
+ (unless (string= (car rev) (to-eol))
+ (error "Missing rev body while parsing rev `%s'" (car rev)))
+ (push (k-one@ 'log '@<-@@) (cdr rev))
+ (push (k-one@ 'text '@<-@@) (cdr rev))
+ (unless (string= (car rev) (cdr (assq 'head headers)))
+ (setcar (cadr rev) :insn)
+ (setcdr (cadr rev)
+ (with-temp-buffer
+ (insert (cdadr rev))
+ (goto-char (point-min))
+ (let (acc start act)
+ (while (re-search-forward "^[ad]" (point-max) t)
+ ;; d:a::k:i
+ (setq start (read (current-buffer))
+ act (read (current-buffer)))
+ (push (if (string= "d" (match-string 0))
+ ;; `d' means "delete lines"
+ `(,start k ,act)
+ ;; `a' means "append after this line" but
+ ;; internally we normalize it so that START
+ ;; specifies the actual line for insert, thus
+ ;; requiring less hair in the realization algs
+ `(,(1+ start) i
+ ,(progn
+ (forward-char 1)
+ (buffer-substring-no-properties
+ (point)
+ (progn (forward-line act)
+ (point))))))
+ acc))
+ (nreverse acc))))))
+ (goto-char start)
+ ;; rv
+ `((headers ,desc ,@headers)
+ (revisions ,@revs)))))
+
+ ;;;; This is unused, included here for completeness.
+ ;;;; (IMHO, there is no harm in including it. --ttn)
+ ;;
+ ;;(defun vc-rcs-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 `vc-rcs-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")
+ ;; (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 "\t@%s@" 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 (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 ""))))))
(provide 'vc-rcs)
next prev parent reply other threads:[~2004-11-10 16:43 UTC|newest]
Thread overview: 19+ messages / expand[flat|nested] mbox.gz Atom feed top
2004-11-09 6:55 patch for documentation about version control Alex Ott
2004-11-09 9:13 ` Andre Spiegel
2004-11-12 9:11 ` Alex Ott
2004-11-09 18:21 ` Karl Fogel
2004-11-09 21:32 ` Stefan Monnier
2004-11-09 21:34 ` Stefan Monnier
2004-11-09 22:09 ` David Kastrup
2004-11-10 9:00 ` Thien-Thi Nguyen
2004-11-10 9:22 ` Andre Spiegel
2004-11-10 16:43 ` Thien-Thi Nguyen [this message]
2004-11-11 11:55 ` Andre Spiegel
2004-11-11 15:11 ` Stefan
2004-11-11 15:36 ` Andre Spiegel
2004-11-11 15:25 ` Thien-Thi Nguyen
2004-11-11 16:06 ` Thien-Thi Nguyen
2004-11-11 18:25 ` Thien-Thi Nguyen
2004-11-11 20:59 ` Andre Spiegel
2004-11-12 9:33 ` Thien-Thi Nguyen
2004-11-10 9:30 ` Andre Spiegel
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=jkr7n14pu2.fsf@glug.org \
--to=ttn@glug.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).