all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: Xue Fuqiao <xfq.free@gmail.com>
To: Glenn Morris <rgm@gnu.org>
Cc: emacs-devel <emacs-devel@gnu.org>
Subject: Re: summer of code results?
Date: Tue, 8 Oct 2013 20:20:31 +0800	[thread overview]
Message-ID: <CAAF+z6ET4bukcuc7jAMCCMC1bv-LD-4z6i0p+1-F_4mRQbKWBw@mail.gmail.com> (raw)
In-Reply-To: <byvc198uqq.fsf@fencepost.gnu.org>

[-- 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
  


  parent reply	other threads:[~2013-10-08 12:20 UTC|newest]

Thread overview: 10+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
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 17:15   ` Glenn Morris
2013-10-08 19:05     ` joakim
2013-10-12  9:59       ` Daimrod
2013-10-12 14:30         ` Stefan Monnier
2013-10-14  3:26           ` joakim
2013-10-08 12:20 ` Xue Fuqiao [this message]
2013-10-08 17:16   ` Glenn Morris

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=CAAF+z6ET4bukcuc7jAMCCMC1bv-LD-4z6i0p+1-F_4mRQbKWBw@mail.gmail.com \
    --to=xfq.free@gmail.com \
    --cc=emacs-devel@gnu.org \
    --cc=rgm@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.