* Re: summer of code results?
2013-10-07 6:23 summer of code results? Glenn Morris
2013-10-07 6:48 ` Stephen J. Turnbull
2013-10-07 9:04 ` joakim
@ 2013-10-08 12:20 ` Xue Fuqiao
2013-10-08 17:16 ` Glenn Morris
2 siblings, 1 reply; 10+ messages in thread
From: Xue Fuqiao @ 2013-10-08 12:20 UTC (permalink / raw)
To: Glenn Morris; +Cc: emacs-devel
[-- Attachment #1: Type: text/plain, Size: 778 bytes --]
On Mon, Oct 7, 2013 at 2:23 PM, Glenn Morris <rgm@gnu.org> wrote:
>
> I see that the summer of code is supposed to have finished a week ago.
> Please could we have a summary of what the two Emacs projects accomplished?
>
> I don't recall hearing any updates or discussion related to the progress
> of either project on this list, which seems like a shame. I heard more
> about the Guile projects than I did about the Emacs ones.
For the VC project:
Code has been progressing in my local bzr branch, and there are three
branches: vc-ignore, vc-shelve, and async-commit. All of vc-ignore and
part of vc-shelve (vc-foo-find-admin-dir) has been merged into trunk,
and I can provide other semi-patches for review.
--
Best regards, Xue Fuqiao.
http://www.gnu.org/software/emacs/
[-- Attachment #2: vc-shelve.patch --]
[-- Type: application/octet-stream, Size: 16270 bytes --]
=== modified file 'lisp/vc/vc-bzr.el'
--- lisp/vc/vc-bzr.el 2013-09-12 06:50:18 +0000
+++ lisp/vc/vc-bzr.el 2013-09-21 10:38:19 +0000
@@ -1014,6 +1014,7 @@
(vc-bzr-after-dir-status update-function
(file-relative-name dir (vc-bzr-root dir)))))
+;; FIXME: Combine it with vc-menu-map
(defvar vc-bzr-shelve-map
(let ((map (make-sparse-keymap)))
;; Turn off vc-dir marking
@@ -1028,6 +1029,7 @@
(define-key map "S" 'vc-bzr-shelve-snapshot)
map))
+;; FIXME: Combine it with vc-menu-map
(defvar vc-bzr-shelve-menu-map
(let ((map (make-sparse-keymap "Bzr Shelve")))
(define-key map [de]
@@ -1044,6 +1046,7 @@
:help "Show the contents of the current shelve"))
map))
+;; FIXME: Combine it with vc-menu-map
(defvar vc-bzr-extra-menu-map
(let ((map (make-sparse-keymap)))
(define-key map [bzr-sn]
@@ -1058,6 +1061,7 @@
(defun vc-bzr-extra-status-menu () vc-bzr-extra-menu-map)
+;; TODO: move part of it to vc-dir.el.
(defun vc-bzr-dir-extra-headers (dir)
(let*
((str (with-temp-buffer
@@ -1131,12 +1135,13 @@
(declare-function vc-resynch-buffer "vc-dispatcher"
(file &optional keep noquery reset-vc-info))
-(defun vc-bzr-shelve (name)
- "Create a shelve."
- (interactive "sShelf name: ")
+(defun vc-bzr-shelve (name fileset)
+ "Temporarily remove changes from the working tree.
+NAME is the shelf name, FILESET is/are the file(s) to be shelved."
(let ((root (vc-bzr-root default-directory)))
(when root
- (vc-bzr-command "shelve" nil 0 nil "--all" "-m" name)
+ (vc-bzr-command
+ "shelve" nil 0 fileset "--all" "-m" name)
(vc-resynch-buffer root t t))))
(defun vc-bzr-shelve-show (name)
@@ -1182,36 +1187,9 @@
(buffer-substring (point-min) (point-max))
"\n"))))
-(defun vc-bzr-shelve-get-at-point (point)
- (save-excursion
- (goto-char point)
- (beginning-of-line)
- (if (looking-at "^ +\\([0-9]+\\):")
- (match-string 1)
- (error "Cannot find shelf at point"))))
-
;; vc-bzr-shelve-delete-at-point must be called from a vc-dir buffer.
(declare-function vc-dir-refresh "vc-dir" ())
-(defun vc-bzr-shelve-delete-at-point ()
- (interactive)
- (let ((shelve (vc-bzr-shelve-get-at-point (point))))
- (when (y-or-n-p (format "Remove shelf %s ? " shelve))
- (vc-bzr-command "unshelve" nil 0 nil "--delete-only" shelve)
- (vc-dir-refresh))))
-
-(defun vc-bzr-shelve-show-at-point ()
- (interactive)
- (vc-bzr-shelve-show (vc-bzr-shelve-get-at-point (point))))
-
-(defun vc-bzr-shelve-apply-at-point ()
- (interactive)
- (vc-bzr-shelve-apply (vc-bzr-shelve-get-at-point (point))))
-
-(defun vc-bzr-shelve-apply-and-keep-at-point ()
- (interactive)
- (vc-bzr-shelve-apply-and-keep (vc-bzr-shelve-get-at-point (point))))
-
(defun vc-bzr-shelve-menu (e)
(interactive "e")
(vc-dir-at-event e (popup-menu vc-bzr-shelve-menu-map e)))
=== modified file 'lisp/vc/vc-dir.el'
--- lisp/vc/vc-dir.el 2013-09-21 08:16:13 +0000
+++ lisp/vc/vc-dir.el 2013-10-01 02:52:09 +0000
@@ -284,6 +284,7 @@
(define-key map (kbd "M-s a C-s") 'vc-dir-isearch)
(define-key map (kbd "M-s a M-C-s") 'vc-dir-isearch-regexp)
(define-key map "G" 'vc-dir-ignore)
+ (define-key map "S" 'vc-dir-shelve)
;; Hook up the menu.
(define-key map [menu-bar vc-dir-mode]
@@ -801,6 +802,47 @@
(interactive)
(vc-ignore (vc-dir-current-file)))
+;; TODO: add a menu entry
+(defun vc-dir-shelve (name)
+ "Temporarily remove changes from the working tree.
+NAME is the shelf name."
+ (interactive "sShelf name:")
+ (vc-shelve name (or (vc-dir-marked-files) (vc-deduce-fileset))))
+
+;; TODO: add a menu entry
+(defun vc-dir-unshelve (name)
+ "Bring the shelved changes NAME (if non-nil) back into the working tree."
+ (interactive "sShelf name: ") ; TODO: use `completing-read' here.
+ (let ((backend (vc-backend default-directory)))
+ (vc-call-backend backend 'unshelve name)
+ (vc-dir-refresh)))
+
+(defun vc-dir-default-unshelve (name)
+ "Bring the shelved changes NAME (if non-nil) back into the working tree."
+ (interactive "sShelf name: ")
+ (let* ((backend (vc-backend default-directory))
+ (shelf (expand-file-name
+ name
+ (expand-file-name
+ "shelf"
+ (vc-call-backend
+ backend 'find-admin-dir default-directory)))))
+ (vc-call-backend backend 'patch shelf)
+ (delete-file shelf)
+ (vc-dir-refresh)))
+
+;; vc-dir-shelve-menu: [down-mouse-3]?
+;; vc-dir-shelve-delete-at-point: C-k
+;; vc-dir-shelve-show-at-point:
+;; vc-dir-shelve-apply-at-point:
+;; vc-dir-shelve-pop-at-point: P
+;; vc-dir-shelve-snapshot:
+
+(defun vc-default-patch (file)
+ "Patch FILE."
+ ;; FIXME: What if `patch' utility is unavailable?
+ (vc-do-command t 0 "patch" file "-p0" "-i"))
+
(defun vc-dir-current-file ()
(let ((node (ewoc-locate vc-ewoc)))
(unless node
@@ -1009,6 +1051,10 @@
(propertize "Working dir: " 'face 'font-lock-type-face)
(propertize (format "%s\n" (abbreviate-file-name dir))
'face 'font-lock-variable-name-face)
+ ;; TODO: change the "(es)" to an ‘if’ expression
+ (propertize "Process(es) running: " 'face 'font-lock-type-face)
+ (propertize (format "%s\n" vc-running-processes)
+ 'face 'font-lock-variable-name-face)
;; Then the backend specific ones.
(vc-call-backend backend 'dir-extra-headers dir)
"\n"))
=== modified file 'lisp/vc/vc-dispatcher.el'
--- lisp/vc/vc-dispatcher.el 2013-09-12 06:58:57 +0000
+++ lisp/vc/vc-dispatcher.el 2013-10-02 02:15:39 +0000
@@ -332,7 +332,7 @@
(setq status proc)
(when vc-command-messages
(vc-run-delayed
- (message "Running %s in background... done" full-command))))
+ (message "Running %s in background... done" full-command))))
;; Run synchronously
(when vc-command-messages
(message "Running %s in foreground..." full-command))
@@ -348,11 +348,18 @@
(error "Running %s...FAILED (%s)" full-command
(if (integerp status) (format "status %d" status) status)))
(when vc-command-messages
- (message "Running %s...OK = %d" full-command status))))
- (vc-run-delayed
- (run-hook-with-args 'vc-post-command-functions
- command file-or-list flags))
- status))))
+ (message "Running %s...OK = %d" full-command status)))
+ (let ((proc-name (process-name (get-buffer-process (current-buffer)))))
+ ;; (unless (member proc-name 'vc-running-processes)
+ ;; If we have two process running at the same time with
+ ;; the same "proc-name", we do want them both to appear in
+ ;; vc-running-processes.
+ (push proc-name vc-running-processes)
+ (vc-run-delayed
+ (vc--remove-process-from-list proc-name)
+ (run-hook-with-args 'vc-post-command-functions
+ command file-or-list flags)))
+ status)))))
(defun vc-do-async-command (buffer root command &rest args)
"Run COMMAND asynchronously with ARGS, displaying the result.
=== modified file 'lisp/vc/vc-git.el'
--- lisp/vc/vc-git.el 2013-10-01 15:34:14 +0000
+++ lisp/vc/vc-git.el 2013-10-06 03:57:30 +0000
@@ -491,20 +491,7 @@
"Return a list of (FILE STATE EXTRA) entries for FILES in DIR."
(vc-git-dir-status-goto-stage 'update-index files update-function))
-(defvar vc-git-stash-map
- (let ((map (make-sparse-keymap)))
- ;; Turn off vc-dir marking
- (define-key map [mouse-2] 'ignore)
-
- (define-key map [down-mouse-3] 'vc-git-stash-menu)
- (define-key map "\C-k" 'vc-git-stash-delete-at-point)
- (define-key map "=" 'vc-git-stash-show-at-point)
- (define-key map "\C-m" 'vc-git-stash-show-at-point)
- (define-key map "A" 'vc-git-stash-apply-at-point)
- (define-key map "P" 'vc-git-stash-pop-at-point)
- (define-key map "S" 'vc-git-stash-snapshot)
- map))
-
+;; FIXME: Merge it with vc-dir.el
(defvar vc-git-stash-menu-map
(let ((map (make-sparse-keymap "Git Stash")))
(define-key map [de]
@@ -1103,13 +1090,15 @@
;; from vc-dispatcher.
(autoload 'vc-resynch-buffer "vc-dispatcher")
-(defun vc-git-stash (name)
+(defun vc-git-stash (name fileset)
"Create a stash."
- (interactive "sStash name: ")
+ ;; (interactive "sStash name: ")
(let ((root (vc-git-root default-directory)))
- (when root
- (vc-git--call nil "stash" "save" name)
- (vc-resynch-buffer root t t))))
+ (if (equal fileset (vc-git-root fileset))
+ (when root
+ (vc-git--call nil "stash" "save" name)
+ (vc-resynch-buffer root t t))
+ (error "Unimplemented"))))
(defun vc-git-stash-show (name)
"Show the contents of stash NAME."
=== modified file 'lisp/vc/vc-hg.el'
--- lisp/vc/vc-hg.el 2013-09-04 21:09:42 +0000
+++ lisp/vc/vc-hg.el 2013-09-21 10:38:19 +0000
@@ -721,6 +721,42 @@
(with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'hg)))
(vc-set-async-update buffer)))
+(defcustom vc-hg-shelve-method 'default
+ "Method of shelving changes.
+Available methods are `default' and `hgshelve'."
+ ;; TODO: auto-detect if the "shelve" extension is installed.
+ :type 'string)
+
+(defun vc-hg-shelve (name fileset)
+ "Temporarily remove changes from the working tree.
+NAME is the shelf name, FILESET is/are the file(s) to be shelved."
+ (cl-case vc-hg-shelve-method
+ (default (vc-default-shelve name fileset))
+ (hgshelve
+ (vc-hg-command t 0 nil "shelve" "--name" name))
+ ;; FIXME: support for FILESET in `hgshelve'
+ (t (user-error "The value of `vc-hg-shelve-method' should be `default' or `hgshelve'"))))
+
+(defun vc-hg-shelve-list ()
+ "See the list of shelves."
+ (cl-case vc-hg-shelve-method
+ (default (vc-default-shelve-list))
+ (hgshelve
+ (vc-hg-command t 0 nil "shelve" "--list"))
+ (t (user-error "The value of `vc-hg-shelve-method' should be `default' or `hgshelve'"))))
+
+(defun vc-hg-unshelve (name)
+ "Bring the shelved changes NAME (if non-nil) back into the working tree."
+ (cl-case vc-hg-shelve-method
+ (default (hg-default-unshelve))
+ (hgshelve (vc-hg-command t 0 nil "unshelve" "--name" name))
+ (t (user-error "The value of `vc-hg-shelve-method' should be `default' or `hgshelve'"))))
+
+(defun vc-hg-patch (file)
+ "Patch FILE."
+ (vc-hg-command t 0 file "import"))
+
+
;;; Internal functions
(defun vc-hg-command (buffer okstatus file-or-list &rest flags)
=== modified file 'lisp/vc/vc-hooks.el'
--- lisp/vc/vc-hooks.el 2013-08-08 23:59:14 +0000
+++ lisp/vc/vc-hooks.el 2013-09-21 10:38:19 +0000
@@ -928,6 +928,7 @@
(define-key map "m" 'vc-merge)
(define-key map "r" 'vc-retrieve-tag)
(define-key map "s" 'vc-create-tag)
+ (define-key map "S" 'vc-shelve)
(define-key map "u" 'vc-revert)
(define-key map "v" 'vc-next-action)
(define-key map "+" 'vc-update)
@@ -1003,6 +1004,9 @@
(bindings--define-key map [vc-register]
'(menu-item "Register" vc-register
:help "Register file set into a version control system"))
+ (bindings--define-key map [vc-shelve]
+ '(menu-item "Shelve..." vc-shelve
+ :help "Temporarily remove changes from the working tree."))
(bindings--define-key map [vc-ignore]
'(menu-item "Ignore File..." vc-ignore
:help "Ignore a file under current version control system"))
=== modified file 'lisp/vc/vc.el'
--- lisp/vc/vc.el 2013-10-04 23:47:00 +0000
+++ lisp/vc/vc.el 2013-10-06 03:59:38 +0000
@@ -351,6 +351,13 @@
;; - find-admin-dir (file)
;;
;; Return the administrative directory of FILE.
+;;
+;; - shelve/unshelve/shelve-list/patch/diff
+;; shelve-get-at-point/shelve-delete-at-point/shelve-show-at-point
+;; shelve-apply-at-point/shelve-apply-and-keep-at-point
+;;
+;; I'll write them until they reach a relatively stable status.
+;;
;; HISTORY FUNCTIONS
;;
@@ -1350,6 +1357,106 @@
(let ((vc-handled-backends (list backend)))
(call-interactively 'vc-register)))
+(defun vc-shelve (name fileset)
+ "Temporarily remove changes from the working tree.
+NAME is the shelf name, FILESET is/are the file(s) to be shelved.
+If NAME is nil or empty string, it will be chosen by VC automatically."
+ ;; TODO: allow the NAME in `shelve' to be nil or "" and to
+ ;; understand this as "let the backend choose a name for me".
+ (interactive "sShelf name: \nfFile: ")
+ (let ((backend (vc-backend fileset)))
+ (vc-call-backend backend 'shelve name fileset)))
+
+(defun vc-default-shelve (name fileset)
+ "Temporarily remove changes from the working tree.
+NAME is the shelf name, FILESET is/are the file(s) to be shelved.
+If NAME is nil or empty string, it will be chosen by VC automatically."
+ (let* ((backend (vc-backend fileset))
+ (dir (vc-default-shelve-dir backend fileset)))
+ (make-directory dir t)
+ (vc-call-backend backend 'diff fileset)
+ (with-current-buffer "*vc-diff*"
+ (write-region (point-min) (point-max)
+ (expand-file-name
+ (or name (vc-default-shelve-name
+ backend))
+ dir)))
+ (vc-call-backend backend 'revert fileset)))
+
+(defun vc-default-shelve-dir (backend fileset)
+ "Return the default shelve directory for FILESET under backend BACKEND."
+ (expand-file-name
+ "shelf"
+ (vc-call-backend backend 'find-admin-dir fileset)))
+
+(defun vc-default-shelve-name (backend)
+ "Return the default shelve name when NAME in `vc-shelve' is nil."
+ (let ((shelve-list (vc-default-shelve-list backend))
+ (i 1))
+ (if (null shelve-list)
+ 1
+ (progn
+ (cl-loop until (null shelve-list) ; require 'cl-lib?
+ do (setq shelve-list (cdr shelve-list)) (cl-incf i))
+ i))))
+
+(defun vc-shelve-list ()
+ "Return the list of shelves."
+ (let ((backend (vc-backend default-directory)))
+ (vc-call-backend backend 'shelve-list default-directory)))
+
+(defun vc-default-shelve-list (backend)
+ "Return the list of shelves."
+ (directory-files (vc-default-shelve-dir backend default-directory)))
+
+(defun vc-shelve-show ()
+ "Show the list of shelves."
+ ;; TODO: accept a `fileset' argument
+ (interactive)
+ (with-current-buffer (get-buffer-create "*vc-shelves*")
+ (cl-loop for shelve in (vc-shelve-list)
+ do (insert (concat shelve "\n"))))
+ (display-buffer "*vc-shelves*"))
+
+(defun vc-shelve-get-at-point (point)
+ (save-excursion
+ (goto-char point)
+ (beginning-of-line)
+ (if (looking-at "^ +\\([0-9]+\\):")
+ (match-string 1)
+ (error "Cannot find shelf at point"))))
+
+(defun vc-shelve-delete-at-point ()
+ (interactive)
+ (let ((shelve (vc-shelve-get-at-point (point))))
+ (when (y-or-n-p (format "Remove shelf %s ? " shelve))
+ (vc-dir-unshelve shelve)
+ ;; TODO: use (vc-call-backend backend 'shelve-delete ...) here
+ (vc-bzr-command "unshelve" nil 0 nil "--delete-only" shelve)
+ (vc-dir-refresh))))
+
+(defun vc-shelve-show-at-point ()
+ (interactive)
+ ;; TODO: use (vc-call-backend backend 'shelve-show ...) here
+ (vc-bzr-shelve-show (vc-shelve-get-at-point (point))))
+
+(defun vc-shelve-apply-at-point ()
+ (interactive)
+ ;; FIXME: use vc-dir-unshelve?
+ (vc-bzr-shelve-apply (vc-shelve-get-at-point (point))))
+
+(defun vc-shelve-apply-and-keep-at-point ()
+ (interactive)
+ ;; FIXME: move vc-bzr-shelve-apply-and-keep from vc-bzr.el?
+ (vc-bzr-shelve-apply-and-keep (vc-shelve-get-at-point (point))))
+
+;; Aliases for Git
+(defalias 'vc-stash 'vc-shelve)
+(defalias 'vc-git-shelve 'vc-git-stash)
+(defalias 'vc-stash-list 'vc-shelve-list)
+(defalias 'vc-dir-stash-apply 'vc-dir-unshelve)
+;; and others, to be added.
+
(defun vc-ignore (file &optional directory)
"Ignore FILE under the VCS of DIRECTORY (default is `default-directory').
FILE is a file wildcard.
@@ -1413,6 +1520,16 @@
(replace-match ""))
(write-region (point-min) (point-max) file)))
+(defun vc--remove-process-from-list (proc)
+ "Remove process PROC from `vc-running-process'.
+PROC is a process name."
+ (setq vc-running-processes
+ (delq (car (member proc vc-running-processes))
+ vc-running-processes)))
+
+(defvar-local vc-running-processes nil
+ "The list of VC processes still running.")
+
(defun vc-checkout (file &optional writable rev)
"Retrieve a copy of the revision REV of FILE.
If WRITABLE is non-nil, make sure the retrieved file is writable.
[-- Attachment #3: async-commit.patch --]
[-- Type: application/octet-stream, Size: 10829 bytes --]
=== modified file 'lisp/vc/vc-bzr.el'
*** lisp/vc/vc-bzr.el 2013-09-12 06:50:18 +0000
--- lisp/vc/vc-bzr.el 2013-09-23 22:44:32 +0000
***************
*** 638,656 ****
"Check FILES in to bzr with log message COMMENT.
REV non-nil gets an error."
(if rev (error "Can't check in a specific revision with bzr"))
! (apply 'vc-bzr-command "commit" nil 0 files
(cons "-m" (log-edit-extract-headers
`(("Author" . ,(vc-bzr--sanitize-header "--author"))
("Date" . ,(vc-bzr--sanitize-header "--commit-time"))
("Fixes" . ,(vc-bzr--sanitize-header "--fixes")))
! comment))))
(defun vc-bzr-find-revision (file rev buffer)
"Fetch revision REV of file FILE and put it into BUFFER."
! (with-current-buffer buffer
! (if (and rev (stringp rev) (not (string= rev "")))
! (vc-bzr-command "cat" t 0 file "-r" rev)
! (vc-bzr-command "cat" t 0 file))))
(defun vc-bzr-find-ignore-file (file)
"Return the root directory of the repository of FILE."
--- 638,668 ----
"Check FILES in to bzr with log message COMMENT.
REV non-nil gets an error."
(if rev (error "Can't check in a specific revision with bzr"))
! (apply 'vc-bzr-command "commit" nil 'async files
(cons "-m" (log-edit-extract-headers
`(("Author" . ,(vc-bzr--sanitize-header "--author"))
("Date" . ,(vc-bzr--sanitize-header "--commit-time"))
("Fixes" . ,(vc-bzr--sanitize-header "--fixes")))
! comment)))
! (vc-exec-after
! (lambda ()
! (with-current-buffer "*vc*"
! (when (progn (goto-char (point-min))
! (search-forward "bzr: ERROR: " nil t))
! (with-vc-properties
! files
! (error "Can't check in: %s"
! (buffer-substring (point)
! (- (search-forward ".\n" nil t) 2)))
! ((vc-state . edited))))))))
!
(defun vc-bzr-find-revision (file rev buffer)
"Fetch revision REV of file FILE and put it into BUFFER."
! (with-current-buffer buffer
! (if (and rev (stringp rev) (not (string= rev "")))
! (vc-bzr-command "cat" t 0 file "-r" rev)
! (vc-bzr-command "cat" t 0 file))))
(defun vc-bzr-find-ignore-file (file)
"Return the root directory of the repository of FILE."
=== modified file 'lisp/vc/vc-dir.el'
*** lisp/vc/vc-dir.el 2013-09-21 08:16:13 +0000
--- lisp/vc/vc-dir.el 2013-09-23 22:44:32 +0000
***************
*** 1028,1061 ****
(generate-new-buffer (format " *VC-%s* tmp status" backend))))
(let ((buffer (current-buffer)))
(with-current-buffer vc-dir-process-buffer
! (setq default-directory def-dir)
! (erase-buffer)
! (vc-call-backend
! backend 'dir-status-files def-dir files default-state
! (lambda (entries &optional more-to-come)
! ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
! ;; If MORE-TO-COME is true, then more updates will come from
! ;; the asynchronous process.
! (with-current-buffer buffer
! (vc-dir-update entries buffer)
! (unless more-to-come
! (setq mode-line-process nil)
! ;; Remove the ones that haven't been updated at all.
! ;; Those not-updated are those whose state is nil because the
! ;; file/dir doesn't exist and isn't versioned.
! (ewoc-filter vc-ewoc
! (lambda (info)
! ;; The state for directory entries might
! ;; have been changed to 'up-to-date,
! ;; reset it, otherwise it will be removed when doing 'x'
! ;; next time.
! ;; FIXME: There should be a more elegant way to do this.
! (when (and (vc-dir-fileinfo->directory info)
! (eq (vc-dir-fileinfo->state info)
! 'up-to-date))
! (setf (vc-dir-fileinfo->state info) nil))
! (not (vc-dir-fileinfo->needs-update info))))))))))))
(defun vc-dir-revert-buffer-function (&optional _ignore-auto _noconfirm)
(vc-dir-refresh))
--- 1028,1063 ----
(generate-new-buffer (format " *VC-%s* tmp status" backend))))
(let ((buffer (current-buffer)))
(with-current-buffer vc-dir-process-buffer
! (vc-exec-after
! (lambda ()
! (setq default-directory def-dir)
! (erase-buffer)
! (vc-call-backend
! backend 'dir-status-files def-dir files default-state
! (lambda (entries &optional more-to-come)
! ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
! ;; If MORE-TO-COME is true, then more updates will come from
! ;; the asynchronous process.
! (with-current-buffer buffer
! (vc-dir-update entries buffer)
! (unless more-to-come
! (setq mode-line-process nil)
! ;; Remove the ones that haven't been updated at all.
! ;; Those not-updated are those whose state is nil because the
! ;; file/dir doesn't exist and isn't versioned.
! (ewoc-filter vc-ewoc
! (lambda (info)
! ;; The state for directory entries might
! ;; have been changed to 'up-to-date,
! ;; reset it, otherwise it will be removed when doing 'x'
! ;; next time.
! ;; FIXME: There should be a more elegant way to do this.
! (when (and (vc-dir-fileinfo->directory info)
! (eq (vc-dir-fileinfo->state info)
! 'up-to-date))
! (setf (vc-dir-fileinfo->state info) nil))
! (not (vc-dir-fileinfo->needs-update info))))))))))))))
(defun vc-dir-revert-buffer-function (&optional _ignore-auto _noconfirm)
(vc-dir-refresh))
***************
*** 1093,1117 ****
(ewoc-set-hf vc-ewoc (vc-dir-headers backend def-dir) "")
(let ((buffer (current-buffer)))
(with-current-buffer vc-dir-process-buffer
! (setq default-directory def-dir)
! (erase-buffer)
! (vc-call-backend
! backend 'dir-status def-dir
! (lambda (entries &optional more-to-come)
! ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
! ;; If MORE-TO-COME is true, then more updates will come from
! ;; the asynchronous process.
! (with-current-buffer buffer
! (vc-dir-update entries buffer)
! (unless more-to-come
! (let ((remaining
! (ewoc-collect
! vc-ewoc 'vc-dir-fileinfo->needs-update)))
! (if remaining
! (vc-dir-refresh-files
! (mapcar 'vc-dir-fileinfo->name remaining)
! 'up-to-date)
! (setq mode-line-process nil))))))))))))
(defun vc-dir-show-fileentry (file)
"Insert an entry for a specific file into the current *VC-dir* listing.
--- 1095,1121 ----
(ewoc-set-hf vc-ewoc (vc-dir-headers backend def-dir) "")
(let ((buffer (current-buffer)))
(with-current-buffer vc-dir-process-buffer
! (vc-exec-after
! (lambda ()
! (setq default-directory def-dir)
! (erase-buffer)
! (vc-call-backend
! backend 'dir-status def-dir
! (lambda (entries &optional more-to-come)
! ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
! ;; If MORE-TO-COME is true, then more updates will come from
! ;; the asynchronous process.
! (with-current-buffer buffer
! (vc-dir-update entries buffer)
! (unless more-to-come
! (let ((remaining
! (ewoc-collect
! vc-ewoc 'vc-dir-fileinfo->needs-update)))
! (if remaining
! (vc-dir-refresh-files
! (mapcar 'vc-dir-fileinfo->name remaining)
! 'up-to-date)
! (setq mode-line-process nil))))))))))))))
(defun vc-dir-show-fileentry (file)
"Insert an entry for a specific file into the current *VC-dir* listing.
=== modified file 'lisp/vc/vc-dispatcher.el'
*** lisp/vc/vc-dispatcher.el 2013-09-12 06:58:57 +0000
--- lisp/vc/vc-dispatcher.el 2013-09-23 22:44:32 +0000
***************
*** 225,231 ****
If the current buffer has no process, just evaluate CODE.
Else, add CODE to the process' sentinel.
CODE should be a function of no arguments."
! (let ((proc (get-buffer-process (current-buffer))))
(cond
;; If there's no background process, just execute the code.
;; We used to explicitly call delete-process on exited processes,
--- 225,233 ----
If the current buffer has no process, just evaluate CODE.
Else, add CODE to the process' sentinel.
CODE should be a function of no arguments."
! (let ((proc (get-buffer-process (current-buffer)))
! (debug (or (get-buffer-process (current-buffer))
! (message (concat "vc-exec-after is executed in " (buffer-name))))))
(cond
;; If there's no background process, just execute the code.
;; We used to explicitly call delete-process on exited processes,
=== modified file 'lisp/vc/vc.el'
*** lisp/vc/vc.el 2013-09-21 08:16:13 +0000
--- lisp/vc/vc.el 2013-09-21 23:22:54 +0000
***************
*** 1508,1526 ****
(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
! backend))
;;; Additional entry points for examining version histories
--- 1508,1529 ----
(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))
! (if (get-buffer-process (current-buffer))
! (message "The process is still running.")
! (message "The process is not running."))))
! 'vc-checkin-hook
! backend)
;;; Additional entry points for examining version histories
^ permalink raw reply [flat|nested] 10+ messages in thread