Merge better fix for #24082

This one lets unregistered files appear in vc-dir.
This commit is contained in:
jca 2016-10-16 18:15:22 +00:00
parent 5b85fde153
commit d2b98b772a
2 changed files with 156 additions and 12 deletions

View File

@ -1,10 +1,10 @@
# $OpenBSD: Makefile,v 1.64 2016/10/13 15:57:24 jca Exp $
# $OpenBSD: Makefile,v 1.65 2016/10/16 18:15:22 jca Exp $
COMMENT= GNU editor: extensible, customizable, self-documenting
VERSION= 25.1
DISTNAME= emacs-${VERSION}
REVISION= 0
REVISION= 1
CATEGORIES= editors

View File

@ -1,15 +1,159 @@
$OpenBSD: patch-lisp_vc_vc-cvs_el,v 1.1 2016/10/13 15:57:24 jca Exp $
$OpenBSD: patch-lisp_vc_vc-cvs_el,v 1.2 2016/10/16 18:15:22 jca Exp $
Bugfix for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=24082
--- lisp/vc/vc-cvs.el.orig Thu Oct 13 17:40:42 2016
+++ lisp/vc/vc-cvs.el Thu Oct 13 17:41:00 2016
@@ -1073,7 +1073,7 @@ Query all files in DIR if files is nil."
--- lisp/vc/vc-cvs.el.orig Wed Jun 29 11:49:20 2016
+++ lisp/vc/vc-cvs.el Sun Oct 16 20:07:06 2016
@@ -938,104 +938,33 @@ state."
(t 'edited))))))))
(defun vc-cvs-after-dir-status (update-function)
- ;; Heavily inspired by vc-cvs-parse-status. AKA a quick hack.
- ;; This needs a lot of testing.
- (let ((status nil)
- (status-str nil)
- (file nil)
- (result nil)
- (missing nil)
- (ignore-next nil)
- (subdir default-directory))
+ (let ((result nil)
+ (translation '((?? . unregistered)
+ (?A . added)
+ (?C . conflict)
+ (?M . edited)
+ (?P . needs-merge)
+ (?R . removed)
+ (?U . needs-update))))
(goto-char (point-min))
- (while
- ;; Look for either a file entry, an unregistered file, or a
- ;; directory change.
- (re-search-forward
- "\\(^=+\n\\([^=c?\n].*\n\\|\n\\)+\\)\\|\\(\\(^?? .*\n\\)+\\)\\|\\(^cvs status: \\(Examining\\|nothing\\) .*\n\\)"
- nil t)
- ;; FIXME: get rid of narrowing here.
- (narrow-to-region (match-beginning 0) (match-end 0))
- (goto-char (point-min))
- ;; The subdir
- (when (looking-at "cvs status: Examining \\(.+\\)")
- (setq subdir (expand-file-name (match-string 1))))
- ;; Unregistered files
- (while (looking-at "? \\(.*\\)")
- (setq file (file-relative-name
- (expand-file-name (match-string 1) subdir)))
- (push (list file 'unregistered) result)
- (forward-line 1))
- (when (looking-at "cvs status: nothing known about")
- ;; We asked about a non existent file. The output looks like this:
+ (while (not (eobp))
+ (if (looking-at "^[ACMPRU?] \\(.*\\)$")
+ (push (list (match-string 1)
+ (cdr (assoc (char-after) translation)))
+ result)
+ (cond
+ ((looking-at "cvs update: warning: \\(.*\\) was lost")
+ ;; Format is:
+ ;; cvs update: warning: FILENAME was lost
+ ;; U FILENAME
+ (push (list (match-string 1) 'missing) result)
+ ;; Skip the "U" line
+ (forward-line 1))
+ ((looking-at "cvs update: New directory `\\(.*\\)' -- ignored")
+ (push (list (match-string 1) 'unregistered) result))))
+ (forward-line 1))
+ (funcall update-function result)))
- ;; cvs status: nothing known about `lisp/v.diff'
- ;; ===================================================================
- ;; File: no file v.diff Status: Unknown
- ;;
- ;; Working revision: No entry for v.diff
- ;; Repository revision: No revision control file
- ;;
-
- ;; Due to narrowing in this iteration we only see the "cvs
- ;; status:" line, so just set a flag so that we can ignore the
- ;; file in the next iteration.
- (setq ignore-next t))
- ;; A file entry.
- (when (re-search-forward "^File: \\(no file \\)?\\(.*[^ \t]\\)[ \t]+Status: \\(.*\\)" nil t)
- (setq missing (match-string 1))
- (setq file (file-relative-name
- (expand-file-name (match-string 2) subdir)))
- (setq status-str (match-string 3))
- (setq status
- (cond
- ((string-match "Up-to-date" status-str) 'up-to-date)
- ((string-match "Locally Modified" status-str) 'edited)
- ((string-match "Needs Merge" status-str) 'needs-merge)
- ((string-match "Needs \\(Checkout\\|Patch\\)" status-str)
- (if missing 'missing 'needs-update))
- ((string-match "Locally Added" status-str) 'added)
- ((string-match "Locally Removed" status-str) 'removed)
- ((string-match "File had conflicts " status-str) 'conflict)
- ((string-match "Unknown" status-str) 'unregistered)
- (t 'edited)))
- (if ignore-next
- (setq ignore-next nil)
- (unless (eq status 'up-to-date)
- (push (list file status) result))))
- (goto-char (point-max))
- (widen))
- (funcall update-function result))
- ;; Alternative implementation: use the "update" command instead of
- ;; the "status" command.
- ;; (let ((result nil)
- ;; (translation '((?? . unregistered)
- ;; (?A . added)
- ;; (?C . conflict)
- ;; (?M . edited)
- ;; (?P . needs-merge)
- ;; (?R . removed)
- ;; (?U . needs-update))))
- ;; (goto-char (point-min))
- ;; (while (not (eobp))
- ;; (if (looking-at "^[ACMPRU?] \\(.*\\)$")
- ;; (push (list (match-string 1)
- ;; (cdr (assoc (char-after) translation)))
- ;; result)
- ;; (cond
- ;; ((looking-at "cvs update: warning: \\(.*\\) was lost")
- ;; ;; Format is:
- ;; ;; cvs update: warning: FILENAME was lost
- ;; ;; U FILENAME
- ;; (push (list (match-string 1) 'missing) result)
- ;; ;; Skip the "U" line
- ;; (forward-line 1))
- ;; ((looking-at "cvs update: New directory `\\(.*\\)' -- ignored")
- ;; (push (list (match-string 1) 'unregistered) result))))
- ;; (forward-line 1))
- ;; (funcall update-function result)))
- )
-
;; Based on vc-cvs-dir-state-heuristic from Emacs 22.
;; FIXME does not mention unregistered files.
(defun vc-cvs-dir-status-heuristic (dir update-function &optional basedir)
@@ -1071,16 +1000,12 @@ state."
Query all files in DIR if files is nil."
(let ((local (vc-cvs-stay-local-p dir)))
(if (and (not files) local (not (eq local 'only-file)))
(vc-cvs-dir-status-heuristic dir update-function)
(if (not files) (setq files (vc-expand-dirs (list dir) 'CVS)))
- (vc-cvs-dir-status-heuristic dir update-function)
- (if (not files) (setq files (vc-expand-dirs (list dir) 'CVS)))
- (vc-cvs-command (current-buffer) 'async files "-f" "status")
+ (vc-cvs-command (current-buffer) 'async dir "-f" "status")
;; Alternative implementation: use the "update" command instead of
;; the "status" command.
;; (vc-cvs-command (current-buffer) 'async
- ;; Alternative implementation: use the "update" command instead of
- ;; the "status" command.
- ;; (vc-cvs-command (current-buffer) 'async
- ;; (file-relative-name dir)
- ;; "-f" "-n" "update" "-d" "-P")
- (vc-run-delayed
- (vc-cvs-after-dir-status update-function)))))
+ (vc-cvs-dir-status-heuristic dir update-function))
+ (vc-cvs-command (current-buffer) 'async
+ files
+ "-f" "-n" "-q" "update")
+ (vc-run-delayed
+ (vc-cvs-after-dir-status update-function))))
(defun vc-cvs-file-to-string (file)
"Read the content of FILE and return it as a string."