mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-27 07:37:33 +00:00
Code Issues Releases Activity

Improved extra-headers method for CVS.

Browse Source
This commit is contained in:
Eric S. Raymond 2008-05-16 19:15:26 +00:00
parent 2ec0d864c1
commit 98712492e7
3 changed files with 40 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lisp/ChangeLog
View File

@ -4,7 +4,7 @@
the end of the file, it was good work at one time but has been
stale since 1995 and may now be actively misleading.
* vc-cvs.el (vc-cvs-status-extra-headers): Extract and display the
CVS repository.
CVS repository and module (assumptions for the latter a bit iffy).
* vc-svn.el (vc-svn-status-extra-headers): Extract and display the
SVN repository.

51
lisp/vc-cvs.el
View File

@ -921,27 +921,50 @@ state."
(vc-exec-after
`(vc-cvs-after-dir-status (quote ,update-function))))
(defun vc-cvs-file-to-string (file)
"Read the content of FILE and return it as a string."
(condition-case nil
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(buffer-substring (point) (point-max)))
(file-error nil)))
(defun vc-cvs-status-extra-headers (dir)
"Extract and represent per-directory properties of a CVS working copy."
(let ((repo
(condition-case nil
(save-excursion
(set-buffer (find-file-noselect "CVS/Root" t))
(condition-case nil
(with-temp-buffer
(insert-file-contents "CVS/Root")
(goto-char (point-min))
(and (looking-at ":ext:") (delete-char 5))
(prog1 (buffer-string) (not-modified) (kill-buffer nil)))
nil)))
(buffer-substring (point) (point-max)))
(file-error nil)))
(module
(condition-case nil
(with-temp-buffer
(insert-file-contents "CVS/Repository")
(goto-char (point-min))
(re-search-forward "[^/]*" nil t)
(concat (match-string 0) "\n"))
(file-error nil))))
(concat
;; FIXME: see how PCL-CVS gets the data to print all these
(propertize "Module : " 'face 'font-lock-type-face)
(propertize "ADD CODE TO PRINT THE MODULE\n"
'face 'font-lock-warning-face)
(cond (module
(concat
(propertize "Module: " 'face 'font-lock-type-face)
(propertize module 'face 'font-lock-variable-name-face)))
(t ""))
(cond (repo
(concat
(propertize "Repository : " 'face 'font-lock-type-face)
(propertize repo 'face 'font-lock-warning-face)))
(propertize "Repository: " 'face 'font-lock-type-face)
(propertize repo 'face 'font-lock-variable-name-face)))
(t ""))
(propertize "Branch : " 'face 'font-lock-type-face)
(propertize "ADD CODE TO PRINT THE BRANCH NAME\n"
'face 'font-lock-warning-face))))
;; In CVS, branch is a per-file property, not a per-directory property. We
;; can't really do this here without making dangerous assumptions.
;;(propertize "Branch: " 'face 'font-lock-type-face)
;;(propertize "ADD CODE TO PRINT THE BRANCH NAME\n"
;; 'face 'font-lock-warning-face)
)))
(defun vc-cvs-get-entries (dir)
"Insert the CVS/Entries file from below DIR into the current buffer.

4
lisp/vc.el
View File

@ -1798,9 +1798,9 @@ See Info node `Merging'."
It calls the `status-extra-headers' backend method to display backend
specific headers."
(concat
(propertize "VC backend : " 'face 'font-lock-type-face)
(propertize "VC backend: " 'face 'font-lock-type-face)
(propertize (format "%s\n" backend) 'face 'font-lock-variable-name-face)
(propertize "Working dir: " 'face 'font-lock-type-face)
(propertize "Working dir: " 'face 'font-lock-type-face)
(propertize (format "%s\n" dir) 'face 'font-lock-variable-name-face)
(vc-call-backend backend 'status-extra-headers dir)
"\n"))