diff options
Diffstat (limited to 'lisp/vc-arch.el')
| -rw-r--r-- | lisp/vc-arch.el | 212 |
1 files changed, 173 insertions, 39 deletions
diff --git a/lisp/vc-arch.el b/lisp/vc-arch.el index b0cdea9d31f..9052a7bb82b 100644 --- a/lisp/vc-arch.el +++ b/lisp/vc-arch.el @@ -62,7 +62,7 @@ ;;; (defvar vc-arch-command - (let ((candidates '("tla"))) + (let ((candidates '("tla" "baz"))) (while (and candidates (not (executable-find (car candidates)))) (setq candidates (cdr candidates))) (or (car candidates) "tla"))) @@ -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 @@ -195,16 +198,17 @@ Only the value `maybe' can be trusted :-(." ;; creates a {arch} directory somewhere. file 'arch-root (vc-find-root file "{arch}/=tagging-method")))) -(defun vc-arch-register (file &optional rev comment) +(defun vc-arch-register (files &optional rev comment) (if rev (error "Explicit initial revision not supported for Arch")) - (let ((tagmet (vc-arch-tagging-method file))) - (if (and (memq tagmet '(tagline implicit)) comment-start) - (with-current-buffer (find-file-noselect file) - (if (buffer-modified-p) - (error "Save %s first" (buffer-name))) - (vc-arch-add-tagline) - (save-buffer)) - (vc-arch-command nil 0 file "add")))) + (dolist (file files) + (let ((tagmet (vc-arch-tagging-method file))) + (if (and (memq tagmet '(tagline implicit)) comment-start) + (with-current-buffer (find-file-noselect file) + (if (buffer-modified-p) + (error "Save %s first" (buffer-name))) + (vc-arch-add-tagline) + (save-buffer))))) + (vc-arch-command nil 0 files "add")) (defun vc-arch-registered (file) ;; Don't seriously check whether it's source or not. Checking would @@ -368,42 +372,49 @@ Return non-nil if FILE is unchanged." (defun vc-arch-checkout-model (file) 'implicit) -(defun vc-arch-checkin (file rev comment) +(defun vc-arch-checkin (files rev comment) (if rev (error "Committing to a specific revision is unsupported")) - (let ((summary (file-relative-name file (vc-arch-root file)))) + ;; FIXME: This implementation probably only works for singleton filesets + (let ((summary (file-relative-name (car file) (vc-arch-root (car files))))) ;; Extract a summary from the comment. (when (or (string-match "\\`Summary:[ \t]*\\(.*[^ \t\n]\\)\\([ \t]*\n\\)*" comment) (string-match "\\`[ \t]*\\(.*[^ \t\n]\\)[ \t]*\\(\n?\\'\\|\n\\([ \t]*\n\\)+\\)" comment)) (setq summary (match-string 1 comment)) (setq comment (substring comment (match-end 0)))) - (vc-arch-command nil 0 file "commit" "-s" summary "-L" comment "--" + (vc-arch-command nil 0 files "commit" "-s" summary "-L" comment "--" (vc-switches 'Arch 'checkin)))) -(defun vc-arch-diff (file &optional oldvers newvers buffer) - "Get a difference report using Arch between two versions of FILE." - (if (and newvers - (vc-up-to-date-p file) - (equal newvers (vc-workfile-version file))) - ;; Newvers is the base revision and the current file is unchanged, - ;; so we can diff with the current file. - (setq newvers nil)) - (if newvers - (error "Diffing specific revisions not implemented") - (let* ((async (and (not vc-disable-async-diff) (fboundp 'start-process))) - ;; Run the command from the root dir. - (default-directory (vc-arch-root file)) - (status - (vc-arch-command - (or buffer "*vc-diff*") - (if async 'async 1) - nil "file-diffs" - ;; Arch does not support the typical flags. - ;; (vc-switches 'Arch 'diff) - (file-relative-name file) - (if (equal oldvers (vc-workfile-version file)) - nil - oldvers)))) - (if async 1 status)))) ; async diff, pessimistic assumption. +(defun vc-arch-diff (files &optional oldvers newvers buffer) + "Get a difference report using Arch between two versions of FILES." + ;; FIXME: This implementation only works for singleton filesets. To make + ;; it work for more cases, we have to either call `file-diffs' manually on + ;; each and every `file' in the fileset, or use `changes --diffs' (and + ;; variants) and maybe filter the output with `filterdiff' to only include + ;; the files in which we're interested. + (let ((file (car files))) + (if (and newvers + (vc-up-to-date-p file) + (equal newvers (vc-workfile-version file))) + ;; Newvers is the base revision and the current file is unchanged, + ;; so we can diff with the current file. + (setq newvers nil)) + (if newvers + (error "Diffing specific revisions not implemented") + (let* ((async (and (not vc-disable-async-diff) (fboundp 'start-process))) + ;; Run the command from the root dir. + (default-directory (vc-arch-root file)) + (status + (vc-arch-command + (or buffer "*vc-diff*") + (if async 'async 1) + nil "file-diffs" + ;; Arch does not support the typical flags. + ;; (vc-switches 'Arch 'diff) + (file-relative-name file) + (if (equal oldvers (vc-workfile-version file)) + nil + oldvers)))) + (if async 1 status))))) ; async diff, pessimistic assumption. (defun vc-arch-delete-file (file) (vc-arch-command nil 0 file "rm")) @@ -419,6 +430,129 @@ Return non-nil if FILE is unchanged." (defun vc-arch-init-version () nil) +;;; Completion of versions and revisions. + +(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))) + (table (vc-arch--version-completion-table root string))) + (complete-with-action action table string pred))))) + +;;; 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) |