From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: storm@cua.dk (Kim F. Storm) Newsgroups: gmane.emacs.devel Subject: Re: Incomplete output from "cvs annotate" Date: 20 Jan 2004 15:44:28 +0100 Sender: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Message-ID: References: <2719-Mon19Jan2004231825+0200-eliz@elta.co.il> NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: sea.gmane.org 1074610368 26843 80.91.224.253 (20 Jan 2004 14:52:48 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Tue, 20 Jan 2004 14:52:48 +0000 (UTC) Cc: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Tue Jan 20 15:52:38 2004 Return-path: Original-Received: from quimby.gnus.org ([80.91.224.244]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1AixF8-0005f9-00 for ; Tue, 20 Jan 2004 15:52:38 +0100 Original-Received: from monty-python.gnu.org ([199.232.76.173]) by quimby.gnus.org with esmtp (Exim 3.35 #1 (Debian)) id 1AixF7-0004Af-00 for ; Tue, 20 Jan 2004 15:52:38 +0100 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.24) id 1Aix2S-0001qn-R6 for emacs-devel@quimby.gnus.org; Tue, 20 Jan 2004 09:39:32 -0500 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.24) id 1Aiwt4-0007oU-Db for emacs-devel@gnu.org; Tue, 20 Jan 2004 09:29:50 -0500 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.24) id 1AiwdH-0004aS-Te for emacs-devel@gnu.org; Tue, 20 Jan 2004 09:14:03 -0500 Original-Received: from [212.88.64.25] (helo=mail-relay.sonofon.dk) by monty-python.gnu.org with smtp (Exim 4.24) id 1AiwCi-0007SF-Gd for emacs-devel@gnu.org; Tue, 20 Jan 2004 08:46:04 -0500 Original-Received: (qmail 94507 invoked from network); 20 Jan 2004 13:44:36 -0000 Original-Received: from unknown (HELO kfs-l.imdomain.dk.cua.dk) (213.83.150.2) by 0 with SMTP; 20 Jan 2004 13:44:36 -0000 Original-To: Simon Josefsson In-Reply-To: Original-Lines: 315 User-Agent: Gnus/5.09 (Gnus v5.9.0) Emacs/21.3.50 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.2 Precedence: list List-Id: Emacs development discussions. List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Xref: main.gmane.org gmane.emacs.devel:19336 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:19336 Simon Josefsson writes: > > Last time I checked, neither SSH nor CVS understood Elisp :-) > > Bummer. (Implement the CVS protocol in elisp...?) You can start here :-) ;;; cvscli.el --- cvs client commands ;; Copyright (C) 1999,2004 Kim F. Storm ;; All rights reserved. ;; Run CVS commands towards CVS server directly in emacs. (defvar cvscli-server-connection nil "Current connection to cvs server") (defvar cvscli-current-config nil "Current cvs server/directory configuration. This is a list with 6 elements: (DIR REPOSITORY PASSWD USER SERVER ROOT)") (defvar cvscli-passwd-alist nil "Passwords alist to use for cvs connections (from .cvspass).") (defvar cvscli-keep-connection t "*When non-nil, keep connection to cvs server.") (defun cvscli-open-connection (dir) (let* ((config (cvscli-get-config dir)) (action (catch 'oc (if (or (null cvscli-server-connection) (eq (process-status cvscli-server-connection) 'closed)) (throw 'oc 'open)) ; no current connection (if (or (not (string-equal (nth 4 cvscli-current-config) (nth 4 config))) (not (string-equal (nth 3 cvscli-current-config) (nth 3 config))) (not (string-equal (nth 5 cvscli-current-config) (nth 5 config)))) (throw 'oc 'reopen)) ; wrong server, user, or root (if (not (string-equal (nth 1 cvscli-current-config) (nth 1 config))) (throw 'oc 'setrep)) ; wrong repository 'done))) (if (eq action 'reopen) (progn (cvscli-close-connection) (setq action 'open))) (if (eq action 'open) (if (catch 'cvserr (if (not (setq cvscli-server-connection (open-network-stream "cvscli" "*vc-info*" (nth 4 config) 2401))) (throw 'cvserr t)) (save-excursion (set-buffer (process-buffer cvscli-server-connection)) (erase-buffer) (set-process-coding-system cvscli-server-connection 'raw-text-unix 'raw-text-unix) ;; (set-process-filter cvscli-server-connection 'cvscli-check-file-filter) (cvscli-send-string (concat "BEGIN AUTH REQUEST\n" (nth 5 config) "\n" (nth 3 config) "\n" (nth 2 config) "\n" "END AUTH REQUEST\n")) ;; response: I LOVE YOU\n (accept-process-output cvscli-server-connection 3) (goto-char (point-min)) (if (not (looking-at "I LOVE YOU")) (progn (cvscli-close-connection) (throw 'cvserr t))) (erase-buffer) (cvscli-send-string (concat "Root " (nth 5 config) "\n")) (cvscli-send-string "\ Valid-responses ok error\ Valid-requests Checked-in New-entry Checksum Copy-file Updated Created\ Update-existing Merged Patched Mode Removed Remove-entry Set-static-directory\ Clear-static-directory Set-sticky Clear-sticky Template Set-checkin-prog\ Set-update-prog Notified Module-expansion M E F UseUnchanged Global_option -r Case ")) (setq action 'setrep) nil) (cvscli-close-connection))) (if (eq action 'setrep) (progn (cvscli-send-string (concat "Directory .\n" (nth 1 config) "\n")) (setq action 'done))) (setq cvscli-current-config config)) (if cvscli-server-connection (save-excursion (set-buffer (process-buffer cvscli-server-connection)) (erase-buffer))) cvscli-server-connection) (defun cvscli-close-connection () (if cvscli-server-connection (progn (if (eq (process-status cvscli-server-connection) 'open) (delete-process cvscli-server-connection)) ; (kill-buffer (process-buffer cvscli-server-connection)) (setq cvscli-server-connection nil)))) (defun cvscli-send-string (str &optional resp) ;; (message "Send: %s" str) (process-send-string cvscli-server-connection str) (if resp (let (ok done) (save-excursion (set-buffer (process-buffer cvscli-server-connection)) (while (not done) (if (not (accept-process-output cvscli-server-connection 3)) (setq done t) (let ((pm (process-mark cvscli-server-connection)) s) (cond ((= pm 3) (setq ok (string-equal (buffer-substring (- pm 3) pm) "ok\n"))) ((> pm 3) (setq ok (string-equal (buffer-substring (- pm 4) pm) "\nok\n")))) (setq done ok)))) (if ok (progn (set-marker (process-mark cvscli-server-connection) (- (point-max) 3)) (delete-region (- (point-max) 3) (point-max)))) ok)) t)) (defun cvscli-check-file (file &optional dir) (if (null dir) (setq dir default-directory)) (let (entry ok fbuf) (setq ok (and (cvscli-open-connection dir) (setq entry (cvscli-get-entry dir file)) (cvscli-send-string (concat "Argument " file "\nEntry /" file "/" (nth 1 entry) "//" (nth 3 entry) "/" (or (nth 4 entry) ""))) (save-excursion (if (and (setq fbuf (find-buffer-visiting (concat dir file))) (set-buffer fbuf) (not buffer-read-only)) (save-restriction (widen) (cvscli-send-string (concat "\nModified " file "\nu=rw,g=rw,o=rw\n" (- (point-max) (point-min)) "\n")) (process-send-region cvscli-server-connection (point-min) (point-max))) (cvscli-send-string (concat "\nUnchanged " file "\n"))) t) (cvscli-send-string "status\n" t) (cvscli-send-string (concat "Argument " file "\neditors\n") t) (cvscli-send-string (concat "Argument " file "\nlog\n") t))) (if ok (save-excursion (set-buffer (process-buffer cvscli-server-connection)) (goto-char (point-min)) (while (and (not (looking-at "head:")) (search-forward-regexp "^M " nil t)) (replace-match "" nil t)))) (if (not cvscli-keep-connection) cvscli-close-connection) ok)) (defun cvscli-get-config (dir) (if (and cvscli-current-config (string-equal dir (car cvscli-current-config))) cvscli-current-config (if (null cvscli-passwd-alist) (let ((pw (expand-file-name "~/.cvspass"))) (if (file-exists-p pw) (let ((buf (find-file-noselect pw)) p s) (save-excursion (set-buffer buf) (goto-char (point-min)) (while (not (eobp)) (setq s (point)) (if (not (search-forward " " nil t)) (forward-line 1) (setq s (buffer-substring s (1- (point)))) (setq p (point)) (end-of-line) (setq p (buffer-substring p (point))) (setq cvscli-passwd-alist (cons (cons s p) cvscli-passwd-alist)) (forward-char 1)))) (kill-buffer buf))))) (let ((rep (concat dir "/CVS/Repository")) (root (concat dir "/CVS/Root")) config) (if (and (file-exists-p root) (file-exists-p rep)) (progn (let ((buf (find-file-noselect root)) pw rep) (save-excursion (set-buffer buf) (setq rep (buffer-substring (point-min) (1- (point-max)))) (setq config (split-string rep "[:@]"))) (kill-buffer buf) (if config (setcar config (and (setq pw (assoc rep cvscli-passwd-alist)) (cdr pw))))) (let ((buf (find-file-noselect rep)) s) (save-excursion (set-buffer buf) (setq config (cons (buffer-substring (point-min) (1- (point-max))) config))) (kill-buffer buf)))) (and config (cons dir config))))) (defun cvscli-get-entry (dir file) (let ((entry (concat dir "/CVS/Entries")) s) (if (file-exists-p entry) (let ((buf (find-file-noselect entry))) (save-excursion (set-buffer buf) (goto-char (point-min)) (if (search-forward-regexp (concat "^/" file "/") nil t) (let (b) (beginning-of-line) (setq b (point)) (end-of-line) (setq s (split-string (buffer-substring b (point)) "/"))))) (kill-buffer buf))) s)) (defun cvscli-check-file-filter (process output-string) (let ((old-buffer (current-buffer))) (unwind-protect (let ((moving)) (set-buffer (process-buffer process)) (setq moving (= (point) (process-mark process))) (save-excursion ;; Insert the text, moving the process-marker. (goto-char (process-mark process)) (insert output-string) (set-marker (process-mark process) (point))) ;;(while (string-match "\r" filtered-string) ;; (setq filtered-string ;; (replace-match "" nil nil filtered-string))) (if moving (goto-char (process-mark process)))) (set-buffer old-buffer)))) (defun vc-ocvs-fetch-master-properties (file fail-ok) ;; Fetch those properties of FILE that are stored in the CVS repository file. (save-excursion ;; Call "cvs emacs" in the right directory, passing only the ;; nondirectory part of the file name -- otherwise CVS might ;; silently give a wrong result. (let ((default-directory (file-name-directory file))) (or (cvscli-check-file (file-name-nondirectory file) default-directory) (vc-simple-command 0 "cvs" (file-name-nondirectory file) "emacs"))) (set-buffer (get-buffer "*vc-info*")) (vc-parse-buffer ;; CVS 1.3 says "RCS Version:", other releases "RCS Revision:", ;; and CVS 1.4a1 says "Repository revision:". '(("\\(RCS Version\\|RCS Revision\\|Repository revision\\):[\t ]+\\([0-9.]+\\)" 2) ("^File: [^ \t]+[ \t]+Status: \\(.*\\)" 1)) file '(vc-latest-version vc-cvs-status)) (vc-parse-buffer '(("Sticky Tag:[ \t]*\\([^\n ]+\\)" 1) ("Sticky Date:[ \t]*\\([^\n ]+\\)" 1) ("Sticky Options:[ \t]*\\([^\n ]+\\)" 1)) file '(vc-sticky-tag vc-sticky-date vc-sticky-options)) (let ((stag (vc-file-getprop file 'vc-sticky-tag)) (sdate (vc-file-getprop file 'vc-sticky-date)) (soptions (vc-file-getprop file 'vc-sticky-options))) (if (and stag (string-match stag "(none)")) (vc-file-setprop file 'vc-sticky-tag nil)) (if (and sdate (string-match sdate "(none)")) (vc-file-setprop file 'vc-sticky-date nil)) (if (and soptions (string-match soptions "(none)")) (vc-file-setprop file 'vc-sticky-options nil))) ;; Translate those status values that we understand into symbols. ;; Any other value is converted to nil. (let ((status (vc-file-getprop file 'vc-cvs-status))) (cond ((string-match "Up-to-date" status) (vc-file-setprop file 'vc-cvs-status 'up-to-date) (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file)))) ((vc-file-setprop file 'vc-cvs-status (cond ((string-match "Locally Modified" status) 'locally-modified) ((string-match "Needs Merge" status) 'needs-merge) ((string-match "Needs \\(Checkout\\|Patch\\)" status) 'needs-checkout) ((string-match "Unresolved Conflict" status) 'unresolved-conflict) ((string-match "Locally Added" status) 'locally-added) (t 'unknown) ))))) (vc-parse-locks file (buffer-substring-no-properties (point-min) (point-max))) (vc-parse-buffer '(("^Head: \\(.*\\)" 1)) file '(vc-latest-version)) )) -- Kim F. Storm http://www.cua.dk