X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/a64bfdfa5a90731b804c057f2bcc74a8ba02937c..f4be80b783f23a54b18dfe43ca649a2f4f31b2a5:/lisp/vc/vc-arch.el diff --git a/lisp/vc/vc-arch.el b/lisp/vc/vc-arch.el index eeac55ac0f..2bc8b7b433 100644 --- a/lisp/vc/vc-arch.el +++ b/lisp/vc/vc-arch.el @@ -1,6 +1,6 @@ -;;; vc-arch.el --- VC backend for the Arch version-control system +;;; vc-arch.el --- VC backend for the Arch version-control system -*- lexical-binding: t -*- -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Stefan Monnier @@ -54,17 +54,22 @@ ;;; Code: -(eval-when-compile (require 'vc) (require 'cl)) +(eval-when-compile (require 'vc)) ;;; Properties of the backend (defun vc-arch-revision-granularity () 'repository) -(defun vc-arch-checkout-model (files) 'implicit) +(defun vc-arch-checkout-model (_files) 'implicit) ;;; ;;; Customization options ;;; +(defgroup vc-arch nil + "VC Arch backend." + :version "24.1" + :group 'vc) + ;; It seems Arch diff does not accept many options, so this is not ;; very useful. It exists mainly so that the VC backends are all ;; consistent with regards to their treatment of diff switches. @@ -76,7 +81,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) :version "23.1" - :group 'vc) + :group 'vc-arch) (define-obsolete-variable-alias 'vc-arch-command 'vc-arch-program "23.1") @@ -87,7 +92,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (or (car candidates) "tla")) "Name of the Arch executable." :type 'string - :group 'vc) + :group 'vc-arch) ;; Clear up the cache to force vc-call to check again and discover ;; new functions when we reload this file. @@ -96,7 +101,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." ;;;###autoload (defun vc-arch-registered (file) ;;;###autoload (if (vc-find-root file "{arch}/=tagging-method") ;;;###autoload (progn -;;;###autoload (load "vc-arch") +;;;###autoload (load "vc-arch" nil t) ;;;###autoload (vc-arch-registered file)))) (defun vc-arch-add-tagline () @@ -222,7 +227,11 @@ Only the value `maybe' can be trusted :-(." (vc-file-setprop file 'arch-root root))))) -(defun vc-arch-register (files &optional rev comment) +(defun vc-arch-find-admin-dir (file) + "Return the administrative directory of FILE." + (expand-file-name "{arch}" (vc-arch-root file))) + +(defun vc-arch-register (files &optional rev _comment) (if rev (error "Explicit initial revision not supported for Arch")) (dolist (file files) (let ((tagmet (vc-arch-tagging-method file))) @@ -253,7 +262,7 @@ Only the value `maybe' can be trusted :-(." ;; Strip the terminating newline. (buffer-substring (point-min) (1- (point-max))))))))) -(defun vc-arch-workfile-unchanged-p (file) +(defun vc-arch-workfile-unchanged-p (_file) "Stub: arch workfiles are always considered to be in a changed state," nil) @@ -306,6 +315,9 @@ Only the value `maybe' can be trusted :-(." 'up-to-date 'edited))))))))) +;; -dir-status called from vc-dir, which loads vc, which loads vc-dispatcher. +(declare-function vc-exec-after "vc-dispatcher" (code)) + (defun vc-arch-dir-status (dir callback) "Run 'tla inventory' for DIR and pass results to CALLBACK. CALLBACK expects (ENTRIES &optional MORE-TO-COME); see @@ -313,8 +325,8 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see (let ((default-directory dir)) (vc-arch-command t 'async nil "changes")) ;; The updating could be done asynchronously. - (vc-exec-after - `(vc-arch-after-dir-status ',callback))) + (vc-run-delayed + (vc-arch-after-dir-status callback))) (defun vc-arch-after-dir-status (callback) (let* ((state-map '(("M " . edited) @@ -377,18 +389,18 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see '(("\\`.*--\\(.*--.*\\)--\\(v?\\).*-\\([0-9]+\\)\\'" . "\\2\\3[\\1]")) "Rewrite rules to shorten Arch's revision names on the mode-line." :type '(repeat (cons regexp string)) - :group 'vc) + :group 'vc-arch) (defun vc-arch-mode-line-string (file) - "Return string for placement in modeline by `vc-mode-line' for FILE." + "Return a string for `vc-mode-line' to put in the mode line for FILE." (let ((rev (vc-working-revision file))) (dolist (rule vc-arch-mode-line-rewrite) (if (string-match (car rule) rev) (setq rev (replace-match (cdr rule) t nil rev)))) (format "Arch%c%s" - (case (vc-state file) - ((up-to-date needs-update) ?-) - (added ?@) + (pcase (vc-state file) + ((or `up-to-date `needs-update) ?-) + (`added ?@) (t ?:)) rev))) @@ -398,7 +410,7 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see (with-temp-buffer (insert-file-contents rej) (goto-char (point-min)) - (looking-at "Conflicts occured, diff3 conflict markers left in file\\."))))) + (looking-at "Conflicts occurred, diff3 conflict markers left in file\\."))))) (defun vc-arch-delete-rej-if-obsolete () "For use in `after-save-hook'." @@ -427,6 +439,8 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see (message "There are unresolved conflicts in %s" (file-name-nondirectory rej)))))) +(autoload 'vc-switches "vc") + (defun vc-arch-checkin (files rev comment) (if rev (error "Committing to a specific revision is unsupported")) ;; FIXME: This implementation probably only works for singleton filesets @@ -503,12 +517,11 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see "*")))))) (defun vc-arch-revision-completion-table (files) - (lexical-let ((files files)) - (lambda (string pred action) - ;; FIXME: complete revision patches as well. - (let* ((root (expand-file-name "{arch}" (vc-arch-root (car files)))) - (table (vc-arch--version-completion-table root string))) - (complete-with-action action table string pred))))) + (lambda (string pred action) + ;; FIXME: complete revision patches as well. + (let* ((root (expand-file-name "{arch}" (vc-arch-root (car files)))) + (table (vc-arch--version-completion-table root string))) + (complete-with-action action table string pred)))) ;;; Trimming revision libraries. @@ -542,13 +555,12 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see minrev)) (defun vc-arch-trim-make-sentinel (revs) - (if (null revs) (lambda (proc msg) (message "VC-Arch trimming ... done")) - (lexical-let ((revs revs)) - (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*"))) + (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*")) + (let ((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) @@ -567,7 +579,7 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see 'car-less-than-car)) (subdirs nil)) (when (cddr revs) - (dotimes (i (/ (length revs) 2)) + (dotimes (_i (/ (length revs) 2)) (let ((minrev (vc-arch-trim-find-least-useful-rev revs))) (setq revs (delq minrev revs)) (push minrev subdirs)))