+2012-04-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/vc-mtn.el:
+ * vc/vc-hg.el:
+ * vc/vc-git.el:
+ * vc/vc-dir.el:
+ * vc/vc-cvs.el:
+ * vc/vc-bzr.el:
+ * vc/vc-arch.el:
+ * vc/vc.el: Replace lexical-let by lexical-binding.
+ * minibuffer.el (lazy-completion-table): Avoid ((λ ...) ...).
+ * emacs-lisp/cl-macs.el (lexical-let): Fix use in lexical-binding.
+ * emacs-lisp/cconv.el (cconv-analyse-form): Warn use of ((λ ...) ...).
+
2012-04-26 Chong Yidong <cyd@gnu.org>
* vc/ediff-wind.el (ediff-setup-windows-default): New function.
(cconv-analyse-form (cadr forms) env)
(setq forms (cddr forms))))
- (`((lambda . ,_) . ,_) ; first element is lambda expression
+ (`((lambda . ,_) . ,_) ; First element is lambda expression.
+ (byte-compile-log-warning
+ "Use of deprecated ((lambda ...) ...) form" t :warning)
(dolist (exp `((function ,(car form)) . ,(cdr form)))
(cconv-analyse-form exp env)))
;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist
;;;;;; do* do loop return-from return block etypecase typecase ecase
;;;;;; case load-time-value eval-when destructuring-bind function*
-;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "91b45885535a73dd8015973cb8c988e1")
+;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "abb2e33c6f61539d69ddbe7c4046261b")
;;; Generated autoloads from cl-macs.el
(autoload 'gensym "cl-macs" "\
(cons 'progn body)
(nconc (mapcar (function (lambda (x)
(list (symbol-name (car x))
- (list 'symbol-value (caddr x))
+ (list 'symbol-value (caddr x))
t))) vars)
(list '(defun . cl-defun-expander))
cl-macro-environment))))
(if (not (get (car (last cl-closure-vars)) 'used))
- (list 'let (mapcar (function (lambda (x)
- (list (caddr x) (cadr x)))) vars)
- (sublis (mapcar (function (lambda (x)
- (cons (caddr x)
- (list 'quote (caddr x)))))
- vars)
- ebody))
+ ;; Turn (let ((foo (gensym))) (set foo <val>) ...(symbol-value foo)...)
+ ;; into (let ((foo <val>)) ...(symbol-value 'foo)...).
+ ;; This is good because it's more efficient but it only works with
+ ;; dynamic scoping, since with lexical scoping we'd need
+ ;; (let ((foo <val>)) ...foo...).
+ `(progn
+ ,@(mapcar (lambda (x) `(defvar ,(caddr x))) vars)
+ (let ,(mapcar (lambda (x) (list (caddr x) (cadr x))) vars)
+ ,(sublis (mapcar (lambda (x)
+ (cons (caddr x)
+ (list 'quote (caddr x))))
+ vars)
+ ebody)))
(list 'let (mapcar (function (lambda (x)
(list (caddr x)
(list 'make-symbol
(when (and enable-local-variables
(not (file-remote-p (or (buffer-file-name) default-directory))))
;; Find the variables file.
- (let ((variables-file (dir-locals-find-file (or (buffer-file-name) default-directory)))
+ (let ((variables-file (dir-locals-find-file
+ (or (buffer-file-name) default-directory)))
(class nil)
(dir-name nil))
(cond
`(completion-table-dynamic
(lambda (,str)
(when (functionp ,var)
- (setq ,var (,fun)))
+ (setq ,var (funcall #',fun)))
,var))))
(defun completion-table-case-fold (table &optional dont-fold)
-;;; 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-2012 Free Software Foundation, Inc.
;;; 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
(vc-file-setprop
file 'arch-root root)))))
-(defun vc-arch-register (files &optional rev comment)
+(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)))
;; 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)
"*"))))))
(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.
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)
'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)))
-;;; vc-bzr.el --- VC backend for the bzr revision control system
+;;; vc-bzr.el --- VC backend for the bzr revision control system -*- lexical-binding: t -*-
;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;;; Properties of the backend
(defun vc-bzr-revision-granularity () 'repository)
-(defun vc-bzr-checkout-model (files) 'implicit)
+(defun vc-bzr-checkout-model (_files) 'implicit)
;;; Code:
;; + working ( = packed_stat )
;; parent = common ( as above ) + history ( = rev_id )
;; kinds = (r)elocated, (a)bsent, (d)irectory, (f)ile, (l)ink
- (lexical-let ((root (vc-bzr-root file)))
+ (let ((root (vc-bzr-root file)))
(when root ; Short cut.
- (lexical-let ((dirstate (expand-file-name vc-bzr-admin-dirstate root)))
+ (let ((dirstate (expand-file-name vc-bzr-admin-dirstate root)))
(condition-case nil
(with-temp-buffer
(insert-file-contents dirstate)
(defun vc-bzr-file-name-relative (filename)
"Return file name FILENAME stripped of the initial Bzr repository path."
- (lexical-let*
- ((filename* (expand-file-name filename))
- (rootdir (vc-bzr-root filename*)))
+ (let* ((filename* (expand-file-name filename))
+ (rootdir (vc-bzr-root filename*)))
(when rootdir
(file-relative-name filename* rootdir))))
(with-temp-buffer
;; This is with-demoted-errors without the condition-case-unless-debug
;; annoyance, which makes it fail during ert testing.
- (let (err)
- (condition-case err (vc-bzr-command "status" t 0 file)
- (error (message "Error: %S" err) nil)))
+ (condition-case err (vc-bzr-command "status" t 0 file)
+ (error (message "Error: %S" err) nil))
(let ((status 'unchanged))
;; the only secure status indication in `bzr status' output
;; is a couple of lines following the pattern::
(if (file-directory-p file) "/?" "\\*?")
"[ \t\n]*$")
nil t)
- (lexical-let ((statusword (match-string 1)))
+ (let ((statusword (match-string 1)))
;; Erase the status text that matched.
(delete-region (match-beginning 0) (match-end 0))
(setq status
(unless (eobp) (buffer-substring (point) (point-max))))))))
(defun vc-bzr-state (file)
- (lexical-let ((result (vc-bzr-status file)))
+ (let ((result (vc-bzr-status file)))
(when (consp result)
(let ((warnings (cdr result)))
(when warnings
(defun vc-bzr-working-revision (file)
;; Together with the code in vc-state-heuristic, this makes it possible
;; to get the initial VC state of a Bzr file even if Bzr is not installed.
- (lexical-let*
- ((rootdir (vc-bzr-root file))
- (branch-format-file (expand-file-name vc-bzr-admin-branch-format-file
- rootdir))
- (revhistory-file (expand-file-name vc-bzr-admin-revhistory rootdir))
- (lastrev-file (expand-file-name vc-bzr-admin-lastrev rootdir)))
+ (let* ((rootdir (vc-bzr-root file))
+ (branch-format-file (expand-file-name vc-bzr-admin-branch-format-file
+ rootdir))
+ (revhistory-file (expand-file-name vc-bzr-admin-revhistory rootdir))
+ (lastrev-file (expand-file-name vc-bzr-admin-lastrev rootdir)))
;; This looks at internal files to avoid forking a bzr process.
;; May break if they change their format.
(if (and (file-exists-p branch-format-file)
- ;; For lightweight checkouts (obtained with bzr checkout --lightweight)
+ ;; For lightweight checkouts (obtained with bzr co --lightweight)
;; the branch-format-file does not contain the revision
;; information, we need to look up the branch-format-file
;; in the place where the lightweight checkout comes
(when (re-search-forward "file://\\(.+\\)" nil t)
(let ((l-c-parent-dir (match-string 1)))
(when (and (memq system-type '(ms-dos windows-nt))
- (string-match-p "^/[[:alpha:]]:" l-c-parent-dir))
- ;;; The non-Windows code takes a shortcut by using the host/path
- ;;; separator slash as the start of the absolute path. That
- ;;; does not work on Windows, so we must remove it (bug#5345)
+ (string-match-p "^/[[:alpha:]]:"
+ l-c-parent-dir))
+ ;;; The non-Windows code takes a shortcut by using
+ ;;; the host/path separator slash as the start of
+ ;;; the absolute path. That does not work on
+ ;;; Windows, so we must remove it (bug#5345)
(setq l-c-parent-dir (substring l-c-parent-dir 1)))
(setq branch-format-file
(expand-file-name vc-bzr-admin-branch-format-file
l-c-parent-dir))
(setq lastrev-file
- (expand-file-name vc-bzr-admin-lastrev l-c-parent-dir))
- ;; FIXME: maybe it's overkill to check if both these files exist.
+ (expand-file-name vc-bzr-admin-lastrev
+ l-c-parent-dir))
+ ;; FIXME: maybe it's overkill to check if both these
+ ;; files exist.
(and (file-exists-p branch-format-file)
(file-exists-p lastrev-file)))))
t)))
(when (re-search-forward "[0-9]+" nil t)
(buffer-substring (match-beginning 0) (match-end 0))))))
;; fallback to calling "bzr revno"
- (lexical-let*
- ((result (vc-bzr-command-discarding-stderr
- vc-bzr-program "revno" (file-relative-name file)))
- (exitcode (car result))
- (output (cdr result)))
+ (let* ((result (vc-bzr-command-discarding-stderr
+ vc-bzr-program "revno" (file-relative-name file)))
+ (exitcode (car result))
+ (output (cdr result)))
(cond
((eq exitcode 0) (substring output 0 -1))
(t nil))))))
"Create a new Bzr repository."
(vc-bzr-command "init" nil 0 nil))
-(defun vc-bzr-init-revision (&optional file)
+(defun vc-bzr-init-revision (&optional _file)
"Always return nil, as Bzr cannot register explicit versions."
nil)
-(defun vc-bzr-previous-revision (file rev)
+(defun vc-bzr-previous-revision (_file rev)
(if (string-match "\\`[0-9]+\\'" rev)
(number-to-string (1- (string-to-number rev)))
(concat "before:" rev)))
-(defun vc-bzr-next-revision (file rev)
+(defun vc-bzr-next-revision (_file rev)
(if (string-match "\\`[0-9]+\\'" rev)
(number-to-string (1+ (string-to-number rev)))
(error "Don't know how to compute the next revision of %s" rev)))
-(defun vc-bzr-register (files &optional rev comment)
+(defun vc-bzr-register (files &optional rev _comment)
"Register FILES under bzr.
Signal an error unless REV is nil.
COMMENT is ignored."
(vc-bzr-command "cat" t 0 file "-r" rev)
(vc-bzr-command "cat" t 0 file))))
-(defun vc-bzr-checkout (file &optional editable rev)
+(defun vc-bzr-checkout (_file &optional _editable rev)
(if rev (error "Operation not supported")
;; Else, there's nothing to do.
nil))
property containing author and date information."
(apply #'vc-bzr-command "annotate" buffer 'async file "--long" "--all"
(if revision (list "-r" revision)))
- (lexical-let ((table (make-hash-table :test 'equal)))
+ (let ((table (make-hash-table :test 'equal)))
(set-process-filter
(get-buffer-process buffer)
(lambda (proc string)
;; frob the results accordingly.
(file-relative-name ,dir (vc-bzr-root ,dir)))))
-(defun vc-bzr-dir-status-files (dir files default-state update-function)
+(defun vc-bzr-dir-status-files (dir files _default-state update-function)
"Return a list of conses (file . state) for DIR."
(apply 'vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S" files)
(vc-exec-after
"revno" "submit" "tag")))
(defun vc-bzr-revision-completion-table (files)
- (lexical-let ((files files))
- ;; What about using `files'?!? --Stef
- (lambda (string pred action)
- (cond
- ((string-match "\\`\\(ancestor\\|branch\\|\\(revno:\\)?[-0-9]+:\\):"
- string)
- (completion-table-with-context (substring string 0 (match-end 0))
- (apply-partially
- 'completion-table-with-predicate
- 'completion-file-name-table
- 'file-directory-p t)
- (substring string (match-end 0))
- pred
- action))
- ((string-match "\\`\\(before\\):" string)
- (completion-table-with-context (substring string 0 (match-end 0))
- (vc-bzr-revision-completion-table files)
- (substring string (match-end 0))
- pred
- action))
- ((string-match "\\`\\(tag\\):" string)
- (let ((prefix (substring string 0 (match-end 0)))
- (tag (substring string (match-end 0)))
- (table nil)
- process-file-side-effects)
- (with-temp-buffer
- ;; "bzr-1.2 tags" is much faster with --show-ids.
- (process-file vc-bzr-program nil '(t) nil "tags" "--show-ids")
- ;; The output is ambiguous, unless we assume that revids do not
- ;; contain spaces.
- (goto-char (point-min))
- (while (re-search-forward "^\\(.*[^ \n]\\) +[^ \n]*$" nil t)
- (push (match-string-no-properties 1) table)))
- (completion-table-with-context prefix table tag pred action)))
-
- ((string-match "\\`annotate:" string)
- (completion-table-with-context
- (substring string 0 (match-end 0))
- (apply-partially #'completion-table-with-terminator '(":" . "\\`a\\`")
- #'completion-file-name-table)
- (substring string (match-end 0)) pred action))
-
- ((string-match "\\`date:" string)
- (completion-table-with-context
- (substring string 0 (match-end 0))
- '("yesterday" "today" "tomorrow")
- (substring string (match-end 0)) pred action))
-
- ((string-match "\\`\\([a-z]+\\):" string)
- ;; no actual completion for the remaining keywords.
- (completion-table-with-context (substring string 0 (match-end 0))
- (if (member (match-string 1 string)
- vc-bzr-revision-keywords)
- ;; If it's a valid keyword,
- ;; use a non-empty table to
- ;; indicate it.
- '("") nil)
- (substring string (match-end 0))
- pred
- action))
- (t
- ;; Could use completion-table-with-terminator, except that it
- ;; currently doesn't work right w.r.t pcm and doesn't give
- ;; the *Completions* output we want.
- (complete-with-action action (eval-when-compile
- (mapcar (lambda (s) (concat s ":"))
- vc-bzr-revision-keywords))
- string pred))))))
+ ;; What about using `files'?!? --Stef
+ (lambda (string pred action)
+ (cond
+ ((string-match "\\`\\(ancestor\\|branch\\|\\(revno:\\)?[-0-9]+:\\):"
+ string)
+ (completion-table-with-context (substring string 0 (match-end 0))
+ (apply-partially
+ 'completion-table-with-predicate
+ 'completion-file-name-table
+ 'file-directory-p t)
+ (substring string (match-end 0))
+ pred
+ action))
+ ((string-match "\\`\\(before\\):" string)
+ (completion-table-with-context (substring string 0 (match-end 0))
+ (vc-bzr-revision-completion-table files)
+ (substring string (match-end 0))
+ pred
+ action))
+ ((string-match "\\`\\(tag\\):" string)
+ (let ((prefix (substring string 0 (match-end 0)))
+ (tag (substring string (match-end 0)))
+ (table nil)
+ process-file-side-effects)
+ (with-temp-buffer
+ ;; "bzr-1.2 tags" is much faster with --show-ids.
+ (process-file vc-bzr-program nil '(t) nil "tags" "--show-ids")
+ ;; The output is ambiguous, unless we assume that revids do not
+ ;; contain spaces.
+ (goto-char (point-min))
+ (while (re-search-forward "^\\(.*[^ \n]\\) +[^ \n]*$" nil t)
+ (push (match-string-no-properties 1) table)))
+ (completion-table-with-context prefix table tag pred action)))
+
+ ((string-match "\\`annotate:" string)
+ (completion-table-with-context
+ (substring string 0 (match-end 0))
+ (apply-partially #'completion-table-with-terminator '(":" . "\\`a\\`")
+ #'completion-file-name-table)
+ (substring string (match-end 0)) pred action))
+
+ ((string-match "\\`date:" string)
+ (completion-table-with-context
+ (substring string 0 (match-end 0))
+ '("yesterday" "today" "tomorrow")
+ (substring string (match-end 0)) pred action))
+
+ ((string-match "\\`\\([a-z]+\\):" string)
+ ;; no actual completion for the remaining keywords.
+ (completion-table-with-context (substring string 0 (match-end 0))
+ (if (member (match-string 1 string)
+ vc-bzr-revision-keywords)
+ ;; If it's a valid keyword,
+ ;; use a non-empty table to
+ ;; indicate it.
+ '("") nil)
+ (substring string (match-end 0))
+ pred
+ action))
+ (t
+ ;; Could use completion-table-with-terminator, except that it
+ ;; currently doesn't work right w.r.t pcm and doesn't give
+ ;; the *Completions* output we want.
+ (complete-with-action action (eval-when-compile
+ (mapcar (lambda (s) (concat s ":"))
+ vc-bzr-revision-keywords))
+ string pred)))))
(provide 'vc-bzr)
-;;; vc-cvs.el --- non-resident support for CVS version-control
+;;; vc-cvs.el --- non-resident support for CVS version-control -*- lexical-binding: t -*-
;; Copyright (C) 1995, 1998-2012 Free Software Foundation, Inc.
;;; State-changing functions
;;;
-(defun vc-cvs-register (files &optional rev comment)
+(defun vc-cvs-register (files &optional _rev comment)
"Register FILES into the CVS version-control system.
COMMENT can be used to provide an initial description of FILES.
Passes either `vc-cvs-register-switches' or `vc-register-switches'
(declare-function vc-rcs-print-log-cleanup "vc-rcs" ())
-(defun vc-cvs-print-log (files buffer &optional shortlog start-revision-ignored limit)
+(defun vc-cvs-print-log (files buffer &optional _shortlog _start-revision limit)
"Get change logs associated with FILES."
(require 'vc-rcs)
;; It's just the catenation of the individual logs.
(vc-exec-after
`(vc-cvs-after-dir-status (quote ,update-function))))))
-(defun vc-cvs-dir-status-files (dir files default-state update-function)
+(defun vc-cvs-dir-status-files (dir files _default-state update-function)
"Create a list of conses (file . state) for DIR."
(apply 'vc-cvs-command (current-buffer) 'async dir "-f" "status" files)
(vc-exec-after
(buffer-substring (point) (point-max)))
(file-error nil)))
-(defun vc-cvs-dir-extra-headers (dir)
+(defun vc-cvs-dir-extra-headers (_dir)
"Extract and represent per-directory properties of a CVS working copy."
(let ((repo
(condition-case nil
res)))
(defun vc-cvs-revision-completion-table (files)
- (lexical-let ((files files)
- table)
- (setq table (lazy-completion-table
- table (lambda () (vc-cvs-revision-table (car files)))))
+ (letrec ((table (lazy-completion-table
+ table (lambda () (vc-cvs-revision-table (car files))))))
table))
-;;; vc-dir.el --- Directory status display under VC
+;;; vc-dir.el --- Directory status display under VC -*- lexical-binding: t -*-
;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
(defun vc-dir-mark-unmark (mark-unmark-function)
(if (use-region-p)
- (let ((firstl (line-number-at-pos (region-beginning)))
+ (let (;; (firstl (line-number-at-pos (region-beginning)))
(lastl (line-number-at-pos (region-end))))
(save-excursion
(goto-char (region-beginning))
;; Non-nil iff a parent directory of arg is marked.
;; Return value, if non-nil is the `ewoc-data' for the marked parent.
(let* ((argdir (vc-dir-node-directory arg))
- (arglen (length argdir))
+ ;; (arglen (length argdir))
(crt arg)
(found nil))
;; Go through the predecessors, checking if any directory that is
;; FIXME: use vc-dir-child-files-and-states here instead of duplicating it.
(if (vc-dir-fileinfo->directory crt-data)
(let* ((dir (vc-dir-fileinfo->directory crt-data))
- (dirlen (length dir))
+ ;; (dirlen (length dir))
data)
(while
(and (setq crt (ewoc-next vc-ewoc crt))
result)
(if (vc-dir-fileinfo->directory crt-data)
(let* ((dir (vc-dir-fileinfo->directory crt-data))
- (dirlen (length dir))
+ ;; (dirlen (length dir))
data)
(while
(and (setq crt (ewoc-next vc-ewoc crt))
(defun vc-dir-recompute-file-state (fname def-dir)
(let* ((file-short (file-relative-name fname def-dir))
- (remove-me-when-CVS-works
+ (_remove-me-when-CVS-works
(when (eq vc-dir-backend 'CVS)
;; FIXME: Warning: UGLY HACK. The CVS backend caches the state
;; info, this forces the backend to update it.
;; Give a DIRNAME string return the list of all child files shown in
;; the current *vc-dir* buffer.
(let ((crt (ewoc-nth vc-ewoc 0))
- children
- dname)
+ children)
;; Find DIR
(while (and crt (not (string-prefix-p
dirname (vc-dir-node-directory crt))))
(setq crt (ewoc-next vc-ewoc crt)))
(while (and crt (string-prefix-p
dirname
- (setq dname (vc-dir-node-directory crt))))
+ (vc-dir-node-directory crt)))
(let ((data (ewoc-data crt)))
(unless (vc-dir-fileinfo->directory data)
(push (expand-file-name (vc-dir-fileinfo->name data)) children)))
(unless (buffer-live-p vc-dir-process-buffer)
(setq vc-dir-process-buffer
(generate-new-buffer (format " *VC-%s* tmp status" backend))))
- (lexical-let ((buffer (current-buffer)))
+ (let ((buffer (current-buffer)))
(with-current-buffer vc-dir-process-buffer
(setq default-directory def-dir)
(erase-buffer)
(not (vc-dir-fileinfo->needs-update info))))))))))))
-(defun vc-dir-revert-buffer-function (&optional ignore-auto noconfirm)
+(defun vc-dir-revert-buffer-function (&optional _ignore-auto _noconfirm)
(vc-dir-refresh))
(defun vc-dir-refresh ()
;; Bzr has serious locking problems, so setup the headers first (this is
;; synchronous) rather than doing it while dir-status is running.
(ewoc-set-hf vc-ewoc (vc-dir-headers backend def-dir) "")
- (lexical-let ((buffer (current-buffer)))
+ (let ((buffer (current-buffer)))
(with-current-buffer vc-dir-process-buffer
(setq default-directory def-dir)
(erase-buffer)
(let ((use-vc-backend backend))
(vc-dir-mode))))
-(defun vc-default-dir-extra-headers (backend dir)
+(defun vc-default-dir-extra-headers (_backend _dir)
;; Be loud by default to remind people to add code to display
;; backend specific headers.
;; XXX: change this to return nil before the release.
map)
"Local keymap for visiting a file.")
-(defun vc-default-dir-printer (backend fileentry)
+(defun vc-default-dir-printer (_backend fileentry)
"Pretty print FILEENTRY."
;; If you change the layout here, change vc-dir-move-to-goal-column.
;; VC backends can implement backend specific versions of this
'mouse-face 'highlight
'keymap vc-dir-filename-mouse-map))))
-(defun vc-default-extra-status-menu (backend)
+(defun vc-default-extra-status-menu (_backend)
nil)
-(defun vc-default-status-fileinfo-extra (backend file)
+(defun vc-default-status-fileinfo-extra (_backend _file)
"Default absence of extra information returned for a file."
nil)
-;;; vc-git.el --- VC backend for the git version control system
+;;; vc-git.el --- VC backend for the git version control system -*- lexical-binding: t -*-
;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;;; BACKEND PROPERTIES
(defun vc-git-revision-granularity () 'repository)
-(defun vc-git-checkout-model (files) 'implicit)
+(defun vc-git-checkout-model (_files) 'implicit)
;;; STATE-QUERYING FUNCTIONS
(vc-git--state-code diff-letter)))
(if (vc-git--empty-db-p) 'added 'up-to-date)))))
-(defun vc-git-working-revision (file)
+(defun vc-git-working-revision (_file)
"Git-specific version of `vc-working-revision'."
(let* (process-file-side-effects
(str (with-output-to-string
(vc-exec-after
`(vc-git-after-dir-status-stage ',stage ',files ',update-function)))
-(defun vc-git-dir-status (dir update-function)
+(defun vc-git-dir-status (_dir update-function)
"Return a list of (FILE STATE EXTRA) entries for DIR."
;; Further things that would have to be fixed later:
;; - how to handle unregistered directories
;; - how to support vc-dir on a subdir of the project tree
(vc-git-dir-status-goto-stage 'update-index nil update-function))
-(defun vc-git-dir-status-files (dir files default-state update-function)
+(defun vc-git-dir-status-files (_dir files _default-state update-function)
"Return a list of (FILE STATE EXTRA) entries for FILES in DIR."
(vc-git-dir-status-goto-stage 'update-index files update-function))
:help "Show the contents of the current stash"))
map))
-(defun vc-git-dir-extra-headers (dir)
+(defun vc-git-dir-extra-headers (_dir)
(let ((str (with-output-to-string
(with-current-buffer standard-output
(vc-git--out-ok "symbolic-ref" "HEAD"))))
"Create a new Git repository."
(vc-git-command nil 0 nil "init"))
-(defun vc-git-register (files &optional rev comment)
+(defun vc-git-register (files &optional _rev _comment)
"Register FILES into the git version-control system."
(let (flist dlist)
(dolist (crt files)
(declare-function log-edit-extract-headers "log-edit" (headers string))
-(defun vc-git-checkin (files rev comment)
+(defun vc-git-checkin (files _rev comment)
(let ((coding-system-for-write vc-git-commits-coding-system))
(apply 'vc-git-command nil 0 files
(nconc (list "commit" "-m")
nil
"cat-file" "blob" (concat (if rev rev "HEAD") ":" fullname))))
-(defun vc-git-checkout (file &optional editable rev)
+(defun vc-git-checkout (file &optional _editable rev)
(vc-git-command nil 0 file "checkout" (or rev "HEAD")))
(defun vc-git-revert (file &optional contents-done)
(append (vc-switches 'git 'diff)
(list "-p" (or rev1 "HEAD") rev2 "--")))))
-(defun vc-git-revision-table (files)
+(defun vc-git-revision-table (_files)
;; What about `files'?!? --Stef
(let (process-file-side-effects
(table (list "HEAD")))
table))
(defun vc-git-revision-completion-table (files)
- (lexical-let ((files files)
- table)
- (setq table (lazy-completion-table
- table (lambda () (vc-git-revision-table files))))
+ (letrec ((table (lazy-completion-table
+ table (lambda () (vc-git-revision-table files)))))
table))
(defun vc-git-annotate-command (file buf &optional rev)
(vc-git-command nil 0 nil "checkout" "-b" name)
(vc-git-command nil 0 nil "tag" name)))))
-(defun vc-git-retrieve-tag (dir name update)
+(defun vc-git-retrieve-tag (dir name _update)
(let ((default-directory dir))
(vc-git-command nil 0 nil "checkout" name)
;; FIXME: update buffers if `update' is true
-;;; vc-hg.el --- VC backend for the mercurial version control system
+;;; vc-hg.el --- VC backend for the mercurial version control system -*- lexical-binding: t -*-
;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
(defvar vc-hg-history nil)
(defun vc-hg-revision-granularity () 'repository)
-(defun vc-hg-checkout-model (files) 'implicit)
+(defun vc-hg-checkout-model (_files) 'implicit)
;;; State querying functions
;; Modeled after the similar function in vc-cvs.el
(defun vc-hg-revision-completion-table (files)
- (lexical-let ((files files)
- table)
- (setq table (lazy-completion-table
- table (lambda () (vc-hg-revision-table files))))
+ (letrec ((table (lazy-completion-table
+ table (lambda () (vc-hg-revision-table files)))))
table))
(defun vc-hg-annotate-command (file buffer &optional revision)
(expand-file-name (match-string-no-properties 4)
(vc-hg-root default-directory)))))))
-(defun vc-hg-previous-revision (file rev)
+(defun vc-hg-previous-revision (_file rev)
(let ((newrev (1- (string-to-number rev))))
(when (>= newrev 0)
(number-to-string newrev))))
-(defun vc-hg-next-revision (file rev)
+(defun vc-hg-next-revision (_file rev)
(let ((newrev (1+ (string-to-number rev)))
(tip-revision
(with-temp-buffer
"Rename file from OLD to NEW using `hg mv'."
(vc-hg-command nil 0 new "mv" old))
-(defun vc-hg-register (files &optional rev comment)
+(defun vc-hg-register (files &optional _rev _comment)
"Register FILES under hg.
REV is ignored.
COMMENT is ignored."
(declare-function log-edit-extract-headers "log-edit" (headers string))
-(defun vc-hg-checkin (files rev comment)
+(defun vc-hg-checkin (files _rev comment)
"Hg-specific version of `vc-backend-checkin'.
REV is ignored."
(apply 'vc-hg-command nil 0 files
(vc-hg-command buffer 0 file "cat"))))
;; Modeled after the similar function in vc-bzr.el
-(defun vc-hg-checkout (file &optional editable rev)
+(defun vc-hg-checkout (file &optional _editable rev)
"Retrieve a revision of FILE.
EDITABLE is ignored.
REV is the revision to check out into WORKFILE."
'face 'font-lock-comment-face)))))
(defun vc-hg-after-dir-status (update-function)
- (let ((status-char nil)
- (file nil)
+ (let ((file nil)
(translation '((?= . up-to-date)
(?C . up-to-date)
(?A . added)
(vc-exec-after
`(vc-hg-after-dir-status (quote ,update-function))))
-(defun vc-hg-dir-status-files (dir files default-state update-function)
+(defun vc-hg-dir-status-files (dir files _default-state update-function)
(apply 'vc-hg-command (current-buffer) 'async dir "status" "-C" files)
(vc-exec-after
`(vc-hg-after-dir-status (quote ,update-function))))
-;;; vc-mtn.el --- VC backend for Monotone
+;;; vc-mtn.el --- VC backend for Monotone -*- lexical-binding: t -*-
;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;;;###autoload (vc-mtn-registered file))))
(defun vc-mtn-revision-granularity () 'repository)
-(defun vc-mtn-checkout-model (files) 'implicit)
+(defun vc-mtn-checkout-model (_files) 'implicit)
(defun vc-mtn-root (file)
(setq file (if (file-directory-p file)
(t ?:))
branch)))
-(defun vc-mtn-register (files &optional rev comment)
+(defun vc-mtn-register (files &optional _rev _comment)
(vc-mtn-command nil 0 files "add"))
(defun vc-mtn-responsible-p (file) (vc-mtn-root file))
(declare-function log-edit-extract-headers "log-edit" (headers string))
-(defun vc-mtn-checkin (files rev comment)
+(defun vc-mtn-checkin (files _rev comment)
(apply 'vc-mtn-command nil 0 files
(nconc (list "commit" "-m")
(log-edit-extract-headers '(("Author" . "--author")
;; (defun vc-mtn-rollback (files)
;; )
-(defun vc-mtn-print-log (files buffer &optional shortlog start-revision limit)
+(defun vc-mtn-print-log (files buffer &optional _shortlog start-revision limit)
(apply 'vc-mtn-command buffer 0 files "log"
(append
(when start-revision (list "--from" (format "%s" start-revision)))
(push (match-string 0) ids))
ids)))
-(defun vc-mtn-revision-completion-table (files)
+(defun vc-mtn-revision-completion-table (_files)
;; TODO: Implement completion for selectors
;; TODO: Implement completion for composite selectors.
- (lexical-let ((files files))
- ;; What about using `files'?!? --Stef
- (lambda (string pred action)
- (cond
- ;; "Tag" selectors.
- ((string-match "\\`t:" string)
- (complete-with-action action
- (mapcar (lambda (tag) (concat "t:" tag))
- (vc-mtn-list-tags))
- string pred))
- ;; "Branch" selectors.
- ((string-match "\\`b:" string)
- (complete-with-action action
- (mapcar (lambda (tag) (concat "b:" tag))
- (vc-mtn-list-branches))
- string pred))
- ;; "Head" selectors. Not sure how they differ from "branch" selectors.
- ((string-match "\\`h:" string)
- (complete-with-action action
- (mapcar (lambda (tag) (concat "h:" tag))
- (vc-mtn-list-branches))
- string pred))
- ;; "ID" selectors.
- ((string-match "\\`i:" string)
- (complete-with-action action
- (mapcar (lambda (tag) (concat "i:" tag))
- (vc-mtn-list-revision-ids
- (substring string (match-end 0))))
- string pred))
- (t
- (complete-with-action action
- '("t:" "b:" "h:" "i:"
- ;; Completion not implemented for these.
- "a:" "c:" "d:" "e:" "l:")
- string pred))))))
+ ;; What about using `files'?!? --Stef
+ (lambda (string pred action)
+ (cond
+ ;; "Tag" selectors.
+ ((string-match "\\`t:" string)
+ (complete-with-action action
+ (mapcar (lambda (tag) (concat "t:" tag))
+ (vc-mtn-list-tags))
+ string pred))
+ ;; "Branch" selectors.
+ ((string-match "\\`b:" string)
+ (complete-with-action action
+ (mapcar (lambda (tag) (concat "b:" tag))
+ (vc-mtn-list-branches))
+ string pred))
+ ;; "Head" selectors. Not sure how they differ from "branch" selectors.
+ ((string-match "\\`h:" string)
+ (complete-with-action action
+ (mapcar (lambda (tag) (concat "h:" tag))
+ (vc-mtn-list-branches))
+ string pred))
+ ;; "ID" selectors.
+ ((string-match "\\`i:" string)
+ (complete-with-action action
+ (mapcar (lambda (tag) (concat "i:" tag))
+ (vc-mtn-list-revision-ids
+ (substring string (match-end 0))))
+ string pred))
+ (t
+ (complete-with-action action
+ '("t:" "b:" "h:" "i:"
+ ;; Completion not implemented for these.
+ "a:" "c:" "d:" "e:" "l:")
+ string pred)))))
-;;; vc.el --- drive a version-control system from within Emacs
+;;; vc.el --- drive a version-control system from within Emacs -*- lexical-binding: t -*-
;; Copyright (C) 1992-1998, 2000-2012 Free Software Foundation, Inc.
(let* ((vc-fileset (vc-deduce-fileset nil t 'state-model-only-files))
(backend (car vc-fileset))
(files (nth 1 vc-fileset))
- (fileset-only-files (nth 2 vc-fileset))
+ ;; (fileset-only-files (nth 2 vc-fileset))
;; FIXME: We used to call `vc-recompute-state' here.
(state (nth 3 vc-fileset))
;; The backend should check that the checkout-model is consistent
Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
(when vc-before-checkin-hook
(run-hooks 'vc-before-checkin-hook))
- (lexical-let
- ((backend backend))
- (vc-start-logentry
- files comment initial-contents
- "Enter a change comment."
- "*vc-log*"
- (lambda ()
- (vc-call-backend backend 'log-edit-mode))
- (lexical-let ((rev rev))
- (lambda (files comment)
- (message "Checking in %s..." (vc-delistify files))
- ;; "This log message intentionally left almost blank".
- ;; RCS 5.7 gripes about white-space-only comments too.
- (or (and comment (string-match "[^\t\n ]" comment))
- (setq comment "*** empty log message ***"))
- (with-vc-properties
- files
- ;; We used to change buffers to get local value of
- ;; vc-checkin-switches, but 'the' local buffer is
- ;; not a well-defined concept for filesets.
- (progn
- (vc-call-backend backend 'checkin files rev comment)
- (mapc 'vc-delete-automatic-version-backups files))
- `((vc-state . up-to-date)
- (vc-checkout-time . ,(nth 5 (file-attributes file)))
- (vc-working-revision . nil)))
- (message "Checking in %s...done" (vc-delistify files))))
- 'vc-checkin-hook)))
+ (vc-start-logentry
+ files comment initial-contents
+ "Enter a change comment."
+ "*vc-log*"
+ (lambda ()
+ (vc-call-backend backend 'log-edit-mode))
+ (lambda (files comment)
+ (message "Checking in %s..." (vc-delistify files))
+ ;; "This log message intentionally left almost blank".
+ ;; RCS 5.7 gripes about white-space-only comments too.
+ (or (and comment (string-match "[^\t\n ]" comment))
+ (setq comment "*** empty log message ***"))
+ (with-vc-properties
+ files
+ ;; We used to change buffers to get local value of
+ ;; vc-checkin-switches, but 'the' local buffer is
+ ;; not a well-defined concept for filesets.
+ (progn
+ (vc-call-backend backend 'checkin files rev comment)
+ (mapc 'vc-delete-automatic-version-backups files))
+ `((vc-state . up-to-date)
+ (vc-checkout-time . ,(nth 5 (file-attributes file)))
+ (vc-working-revision . nil)))
+ (message "Checking in %s...done" (vc-delistify files)))
+ 'vc-checkin-hook))
;;; Additional entry points for examining version histories
(list files rev1 rev2))))
;;;###autoload
-(defun vc-version-diff (files rev1 rev2)
+(defun vc-version-diff (_files rev1 rev2)
"Report diffs between revisions of the fileset in the repository history."
(interactive (vc-diff-build-argument-list-internal))
;; All that was just so we could do argument completion!
"Enter a replacement change comment."
"*vc-log*"
(lambda () (vc-call-backend backend 'log-edit-mode))
- (lexical-let ((rev rev)
- (backend backend))
- (lambda (files comment)
- (vc-call-backend backend
- 'modify-change-comment files rev comment))))))
+ (lambda (files comment)
+ (vc-call-backend backend
+ 'modify-change-comment files rev comment)))))
;;;###autoload
(defun vc-merge ()
(error "Sorry, merging is not implemented for %s" backend)))))
-(defun vc-maybe-resolve-conflicts (file status &optional name-A name-B)
+(defun vc-maybe-resolve-conflicts (file status &optional _name-A _name-B)
(vc-resynch-buffer file t (not (buffer-modified-p)))
(if (zerop status) (message "Merge successful")
(smerge-mode 1)
(when (and limit (not (eq 'limit-unsupported pl-return))
(not is-start-revision))
(goto-char (point-max))
- (lexical-let ((working-revision working-revision)
- (limit limit))
- (insert "\n")
- (insert-text-button "Show 2X entries"
- 'action (lambda (&rest ignore)
- (vc-print-log-internal
- log-view-vc-backend log-view-vc-fileset
- working-revision nil (* 2 limit)))
- 'help-echo "Show the log again, and double the number of log entries shown")
- (insert " ")
- (insert-text-button "Show unlimited entries"
- 'action (lambda (&rest ignore)
- (vc-print-log-internal
- log-view-vc-backend log-view-vc-fileset
- working-revision nil nil))
- 'help-echo "Show the log again, including all entries"))))
+ (insert "\n")
+ (insert-text-button "Show 2X entries"
+ 'action (lambda (&rest _ignore)
+ (vc-print-log-internal
+ log-view-vc-backend log-view-vc-fileset
+ working-revision nil (* 2 limit)))
+ 'help-echo "Show the log again, and double the number of log entries shown")
+ (insert " ")
+ (insert-text-button "Show unlimited entries"
+ 'action (lambda (&rest _ignore)
+ (vc-print-log-internal
+ log-view-vc-backend log-view-vc-fileset
+ working-revision nil nil))
+ 'help-echo "Show the log again, including all entries")))
(defun vc-print-log-internal (backend files working-revision
&optional is-start-revision limit)
(let ((dir-present nil)
(vc-short-log nil)
(buffer-name "*vc-change-log*")
- type
- pl-return)
+ type)
(dolist (file files)
(when (file-directory-p file)
(setq dir-present t)))
(memq 'directory vc-log-short-style)
(memq 'file vc-log-short-style)))))
(setq type (if vc-short-log 'short 'long))
- (lexical-let
- ((working-revision working-revision)
- (backend backend)
- (limit limit)
- (shortlog vc-short-log)
- (files files)
- (is-start-revision is-start-revision))
+ (let ((shortlog vc-short-log))
(vc-log-internal-common
backend buffer-name files type
- (lambda (bk buf type-arg files-arg)
- (vc-call-backend bk 'print-log files-arg buf
- shortlog (when is-start-revision working-revision) limit))
- (lambda (bk files-arg ret)
+ (lambda (bk buf _type-arg files-arg)
+ (vc-call-backend bk 'print-log files-arg buf shortlog
+ (when is-start-revision working-revision) limit))
+ (lambda (_bk _files-arg ret)
(vc-print-log-setup-buttons working-revision
is-start-revision limit ret))
(lambda (bk)
(vc-call-backend bk 'show-log-entry working-revision))
- (lambda (ignore-auto noconfirm)
- (vc-print-log-internal backend files working-revision is-start-revision limit))))))
+ (lambda (_ignore-auto _noconfirm)
+ (vc-print-log-internal backend files working-revision
+ is-start-revision limit))))))
(defvar vc-log-view-type nil
"Set this to differentiate the different types of logs.")
(defun vc-incoming-outgoing-internal (backend remote-location buffer-name type)
(vc-log-internal-common
backend buffer-name nil type
- (lexical-let
- ((remote-location remote-location))
- (lambda (bk buf type-arg files)
- (vc-call-backend bk type-arg buf remote-location)))
- (lambda (bk files-arg ret))
- (lambda (bk)
- (goto-char (point-min)))
- (lexical-let
- ((backend backend)
- (remote-location remote-location)
- (buffer-name buffer-name)
- (type type))
- (lambda (ignore-auto noconfirm)
- (vc-incoming-outgoing-internal backend remote-location buffer-name type)))))
+ (lambda (bk buf type-arg _files)
+ (vc-call-backend bk type-arg buf remote-location))
+ (lambda (_bk _files-arg _ret) nil)
+ (lambda (_bk) (goto-char (point-min)))
+ (lambda (_ignore-auto _noconfirm)
+ (vc-incoming-outgoing-internal backend remote-location buffer-name type))))
;;;###autoload
(defun vc-print-log (&optional working-revision limit)
(interactive
(when current-prefix-arg
(list (read-string "Remote location (empty for default): "))))
- (let ((backend (vc-deduce-backend))
- rootdir working-revision)
+ (let ((backend (vc-deduce-backend)))
(unless backend
(error "Buffer is not version controlled"))
- (vc-incoming-outgoing-internal backend remote-location "*vc-incoming*" 'log-incoming)))
+ (vc-incoming-outgoing-internal backend remote-location "*vc-incoming*"
+ 'log-incoming)))
;;;###autoload
(defun vc-log-outgoing (&optional remote-location)
(interactive
(when current-prefix-arg
(list (read-string "Remote location (empty for default): "))))
- (let ((backend (vc-deduce-backend))
- rootdir working-revision)
+ (let ((backend (vc-deduce-backend)))
(unless backend
(error "Buffer is not version controlled"))
- (vc-incoming-outgoing-internal backend remote-location "*vc-outgoing*" 'log-outgoing)))
+ (vc-incoming-outgoing-internal backend remote-location "*vc-outgoing*"
+ 'log-outgoing)))
;;;###autoload
(defun vc-revert ()
(when index
(substring rev 0 index))))
-(defun vc-default-responsible-p (backend file)
+(defun vc-default-responsible-p (_backend _file)
"Indicate whether BACKEND is responsible for FILE.
The default is to return nil always."
nil)
-(defun vc-default-could-register (backend file)
+(defun vc-default-could-register (_backend _file)
"Return non-nil if BACKEND could be used to register FILE.
The default implementation returns t for all files."
t)
-(defun vc-default-latest-on-branch-p (backend file)
+(defun vc-default-latest-on-branch-p (_backend _file)
"Return non-nil if FILE is the latest on its branch.
This default implementation always returns non-nil, which means that
editing non-current revisions is not supported by default."
t)
-(defun vc-default-init-revision (backend) vc-default-init-revision)
+(defun vc-default-init-revision (_backend) vc-default-init-revision)
(defun vc-default-find-revision (backend file rev buffer)
"Provide the new `find-revision' op based on the old `checkout' op.
(insert-file-contents-literally tmpfile)))
(delete-file tmpfile))))
-(defun vc-default-rename-file (backend old new)
+(defun vc-default-rename-file (_backend old new)
(condition-case nil
(add-name-to-file old new)
(error (rename-file old new)))
(declare-function log-edit-mode "log-edit" ())
-(defun vc-default-log-edit-mode (backend) (log-edit-mode))
+(defun vc-default-log-edit-mode (_backend) (log-edit-mode))
-(defun vc-default-log-view-mode (backend) (log-view-mode))
+(defun vc-default-log-view-mode (_backend) (log-view-mode))
-(defun vc-default-show-log-entry (backend rev)
+(defun vc-default-show-log-entry (_backend rev)
(with-no-warnings
(log-view-goto-rev rev)))
(defalias 'vc-default-revision-completion-table 'ignore)
(defalias 'vc-default-mark-resolved 'ignore)
-(defun vc-default-dir-status-files (backend dir files default-state update-function)
+(defun vc-default-dir-status-files (_backend _dir files default-state update-function)
(funcall update-function
(mapcar (lambda (file) (list file default-state)) files)))
projects / emacs.git / commitdiff