Commit 56dada42 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

(vc-arch-add-tagline): Do a slightly cleaner job.

(vc-arch-complete, vc-arch--version-completion-table)
(vc-arch-revision-completion-table): New functions to provide
completion of revision names.
(vc-arch-trim-find-least-useful-rev, vc-arch-trim-make-sentinel)
(vc-arch-trim-one-revlib, vc-arch-trim-revlib): New functions
to let the user trim the revlib.
parent 4d83a657
......@@ -74,10 +74,11 @@ recenter the visited source file. Its value can be a number (for example,
Only copyright lines with holders matching copyright-names-regexp will be
considered for update.
** VC
*** VC backends can provide completion of revision names.
*** VC has some support for Bazaar (bzr).
** VC has some support for Bazaar (bzr).
** VC has some support for Mercurial (hg).
*** VC has some support for Mercurial (hg).
** sgml-electric-tag-pair-mode lets you simultaneously edit matched tag pairs.
......
2007-06-26 Stefan Monnier <monnier@iro.umontreal.ca>
* vc-arch.el (vc-arch-add-tagline): Do a slightly cleaner job.
(vc-arch-complete, vc-arch--version-completion-table)
(vc-arch-revision-completion-table): New functions to provide
completion of revision names.
(vc-arch-trim-find-least-useful-rev, vc-arch-trim-make-sentinel)
(vc-arch-trim-one-revlib, vc-arch-trim-revlib): New functions
to let the user trim the revlib.
* vc.el: Add new VC operation `revision-completion-table'.
(vc-default-revision-completion-table): New function.
(vc-version-diff, vc-version-other-window): Use it to provide
......
......@@ -83,7 +83,10 @@
(comment-normalize-vars)
(goto-char (point-max))
(forward-comment -1)
(unless (bolp) (insert "\n"))
(skip-chars-forward " \t\n")
(cond
((not (bolp)) (insert "\n\n"))
((not (eq ?\n (char-before (1- (point))))) (insert "\n")))
(let ((beg (point))
(idfile (and buffer-file-name
(expand-file-name
......@@ -419,6 +422,137 @@ Return non-nil if FILE is unchanged."
(defun vc-arch-init-version () nil)
;;; Completion of versions and revisions.
(defun vc-arch-complete (table string pred action)
(assert (not (functionp table)))
(cond
((null action) (try-completion string table pred))
((eq action t) (all-completions string table pred))
(t (test-completion string table pred))))
(defun vc-arch--version-completion-table (root string)
(delq nil
(mapcar
(lambda (d)
(when (string-match "/\\([^/]+\\)/\\([^/]+\\)\\'" d)
(concat (match-string 2 d) "/" (match-string 1 d))))
(let ((default-directory root))
(file-expand-wildcards
(concat "*/*/"
(if (string-match "/" string)
(concat (substring string (match-end 0))
"*/" (substring string 0 (match-beginning 0)))
(concat "*/" string))
"*"))))))
(defun vc-arch-revision-completion-table (file)
(lexical-let ((file file))
(lambda (string pred action)
;; FIXME: complete revision patches as well.
(let ((root (expand-file-name "{arch}" (vc-arch-root file))))
(vc-arch-complete
(vc-arch--version-completion-table root string)
string pred action)))))
;;; Trimming revision libraries.
;; This code is not directly related to VC and there are many variants of
;; this functionality available as scripts, but I like this version better,
;; so maybe others will like it too.
(defun vc-arch-trim-find-least-useful-rev (revs)
(let* ((first (pop revs))
(second (pop revs))
(third (pop revs))
;; We try to give more importance to recent revisions. The idea is
;; that it's OK if checking out a revision 1000-patch-old is ten
;; times slower than checking out a revision 100-patch-old. But at
;; the same time a 2-patch-old rev isn't really ten times more
;; important than a 20-patch-old, so we use an arbitrary constant
;; "100" to reduce this effect for recent revisions. Making this
;; constant a float has the side effect of causing the subsequent
;; computations to be done as floats as well.
(max (+ 100.0 (car (or (car (last revs)) third))))
(cost (lambda () (/ (- (car third) (car first)) (- max (car second)))))
(minrev second)
(mincost (funcall cost)))
(while revs
(setq first second)
(setq second third)
(setq third (pop revs))
(when (< (funcall cost) mincost)
(setq minrev second)
(setq mincost (funcall cost))))
minrev))
(defun vc-arch-trim-make-sentinel (revs)
(if (null revs) (lambda (proc msg) (message "VC-Arch trimming ... done"))
`(lambda (proc msg)
(message "VC-Arch trimming %s..." ',(file-name-nondirectory (car revs)))
(rename-file ,(car revs) ,(concat (car revs) "*rm*"))
(setq proc (start-process "vc-arch-trim" nil
"rm" "-rf" ',(concat (car revs) "*rm*")))
(set-process-sentinel proc (vc-arch-trim-make-sentinel ',(cdr revs))))))
(defun vc-arch-trim-one-revlib (dir)
"Delete half of the revisions in the revision library."
(interactive "Ddirectory: ")
(let ((revs
(sort (delq nil
(mapcar
(lambda (f)
(when (string-match "-\\([0-9]+\\)\\'" f)
(cons (string-to-number (match-string 1 f)) f)))
(directory-files dir nil nil 'nosort)))
'car-less-than-car))
(subdirs nil))
(when (cddr revs)
(dotimes (i (/ (length revs) 2))
(let ((minrev (vc-arch-trim-find-least-useful-rev revs)))
(setq revs (delq minrev revs))
(push minrev subdirs)))
(funcall (vc-arch-trim-make-sentinel
(mapcar (lambda (x) (expand-file-name (cdr x) dir)) subdirs))
nil nil))))
(defun vc-arch-trim-revlib ()
"Delete half of the revisions in the revision library."
(interactive)
(let ((rl-dir (with-output-to-string
(call-process vc-arch-command nil standard-output nil
"my-revision-library"))))
(while (string-match "\\(.*\\)\n" rl-dir)
(let ((dir (match-string 1 rl-dir)))
(setq rl-dir
(if (and (file-directory-p dir) (file-writable-p dir))
dir
(substring rl-dir (match-end 0))))))
(unless (file-writable-p rl-dir)
(error "No writable revlib directory found"))
(message "Revlib at %s" rl-dir)
(let* ((archives (directory-files rl-dir 'full "[^.]\\|..."))
(categories
(apply 'append
(mapcar (lambda (dir)
(when (file-directory-p dir)
(directory-files dir 'full "[^.]\\|...")))
archives)))
(branches
(apply 'append
(mapcar (lambda (dir)
(when (file-directory-p dir)
(directory-files dir 'full "[^.]\\|...")))
categories)))
(versions
(apply 'append
(mapcar (lambda (dir)
(when (file-directory-p dir)
(directory-files dir 'full "--.*--")))
branches))))
(mapc 'vc-arch-trim-one-revlib versions))
))
;;; Less obvious implementations.
(defun vc-arch-find-version (file rev buffer)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment