diff options
| author | Stefan Monnier | 2013-11-05 10:27:51 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2013-11-05 10:27:51 -0500 |
| commit | 0acfafef3adde5bc0228eb16d7ab4b3fbfe3bf20 (patch) | |
| tree | 122d277785b3ba7c59fb0d9a40827edd2ed6e8d9 | |
| parent | a213a54163278b3b2598255cc913825539a119fe (diff) | |
| download | emacs-0acfafef3adde5bc0228eb16d7ab4b3fbfe3bf20.tar.gz emacs-0acfafef3adde5bc0228eb16d7ab4b3fbfe3bf20.zip | |
* lisp/vc/vc-rcs.el (vc-rcs-parse): Make `gather' get e, b, and @-holes
via arguments so as to get the right ones.
Fixes: debbugs:15418
| -rw-r--r-- | lisp/ChangeLog | 3 | ||||
| -rw-r--r-- | lisp/vc/vc-rcs.el | 60 |
2 files changed, 33 insertions, 30 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index cd8342fdb49..6b7f169887c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,5 +1,8 @@ | |||
| 1 | 2013-11-05 Stefan Monnier <monnier@iro.umontreal.ca> | 1 | 2013-11-05 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 2 | ||
| 3 | * vc/vc-rcs.el (vc-rcs-parse): Make `gather' get e, b, and @-holes | ||
| 4 | via arguments so as to get the right ones (bug#15418). | ||
| 5 | |||
| 3 | * net/rcirc.el (rcirc-record-activity): Don't abuse add-to-list. | 6 | * net/rcirc.el (rcirc-record-activity): Don't abuse add-to-list. |
| 4 | 7 | ||
| 5 | 2013-11-05 Michael Albinus <michael.albinus@gmx.de> | 8 | 2013-11-05 Michael Albinus <michael.albinus@gmx.de> |
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el index 618250dedab..8935ed82a2a 100644 --- a/lisp/vc/vc-rcs.el +++ b/lisp/vc/vc-rcs.el | |||
| @@ -294,7 +294,7 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile." | |||
| 294 | nil ".*,v$" t)) | 294 | nil ".*,v$" t)) |
| 295 | (yes-or-no-p "Create RCS subdirectory? ") | 295 | (yes-or-no-p "Create RCS subdirectory? ") |
| 296 | (make-directory subdir)) | 296 | (make-directory subdir)) |
| 297 | (apply 'vc-do-command "*vc*" 0 "ci" file | 297 | (apply #'vc-do-command "*vc*" 0 "ci" file |
| 298 | ;; if available, use the secure registering option | 298 | ;; if available, use the secure registering option |
| 299 | (and (vc-rcs-release-p "5.6.4") "-i") | 299 | (and (vc-rcs-release-p "5.6.4") "-i") |
| 300 | (concat (if vc-keep-workfiles "-u" "-r") rev) | 300 | (concat (if vc-keep-workfiles "-u" "-r") rev) |
| @@ -375,7 +375,7 @@ whether to remove it." | |||
| 375 | (setq switches (cons "-f" switches))) | 375 | (setq switches (cons "-f" switches))) |
| 376 | (if (and (not rev) old-version) | 376 | (if (and (not rev) old-version) |
| 377 | (setq rev (vc-branch-part old-version))) | 377 | (setq rev (vc-branch-part old-version))) |
| 378 | (apply 'vc-do-command "*vc*" 0 "ci" (vc-name file) | 378 | (apply #'vc-do-command "*vc*" 0 "ci" (vc-name file) |
| 379 | ;; if available, use the secure check-in option | 379 | ;; if available, use the secure check-in option |
| 380 | (and (vc-rcs-release-p "5.6.4") "-j") | 380 | (and (vc-rcs-release-p "5.6.4") "-j") |
| 381 | (concat (if vc-keep-workfiles "-u" "-r") rev) | 381 | (concat (if vc-keep-workfiles "-u" "-r") rev) |
| @@ -411,7 +411,7 @@ whether to remove it." | |||
| 411 | (concat "-u" old-version))))))))) | 411 | (concat "-u" old-version))))))))) |
| 412 | 412 | ||
| 413 | (defun vc-rcs-find-revision (file rev buffer) | 413 | (defun vc-rcs-find-revision (file rev buffer) |
| 414 | (apply 'vc-do-command | 414 | (apply #'vc-do-command |
| 415 | (or buffer "*vc*") 0 "co" (vc-name file) | 415 | (or buffer "*vc*") 0 "co" (vc-name file) |
| 416 | "-q" ;; suppress diagnostic output | 416 | "-q" ;; suppress diagnostic output |
| 417 | (concat "-p" rev) | 417 | (concat "-p" rev) |
| @@ -443,7 +443,7 @@ attempt the checkout for all registered files beneath it." | |||
| 443 | (and rev (string= rev "") | 443 | (and rev (string= rev "") |
| 444 | (vc-rcs-set-default-branch file nil)) | 444 | (vc-rcs-set-default-branch file nil)) |
| 445 | ;; now do the checkout | 445 | ;; now do the checkout |
| 446 | (apply 'vc-do-command | 446 | (apply #'vc-do-command |
| 447 | "*vc*" 0 "co" (vc-name file) | 447 | "*vc*" 0 "co" (vc-name file) |
| 448 | ;; If locking is not strict, force to overwrite | 448 | ;; If locking is not strict, force to overwrite |
| 449 | ;; the writable workfile. | 449 | ;; the writable workfile. |
| @@ -585,7 +585,7 @@ files beneath it." | |||
| 585 | 585 | ||
| 586 | (defun vc-rcs-diff (files &optional oldvers newvers buffer) | 586 | (defun vc-rcs-diff (files &optional oldvers newvers buffer) |
| 587 | "Get a difference report using RCS between two sets of files." | 587 | "Get a difference report using RCS between two sets of files." |
| 588 | (apply 'vc-do-command (or buffer "*vc-diff*") | 588 | (apply #'vc-do-command (or buffer "*vc-diff*") |
| 589 | 1 ;; Always go synchronous, the repo is local | 589 | 1 ;; Always go synchronous, the repo is local |
| 590 | "rcsdiff" (vc-expand-dirs files) | 590 | "rcsdiff" (vc-expand-dirs files) |
| 591 | (append (list "-q" | 591 | (append (list "-q" |
| @@ -787,7 +787,7 @@ Optional arg REVISION is a revision to annotate from." | |||
| 787 | (cl-flet ((pad (w) (substring-no-properties padding w)) | 787 | (cl-flet ((pad (w) (substring-no-properties padding w)) |
| 788 | (render (rda &rest ls) | 788 | (render (rda &rest ls) |
| 789 | (propertize | 789 | (propertize |
| 790 | (apply 'concat | 790 | (apply #'concat |
| 791 | (format-time-string "%Y-%m-%d" (aref rda 1)) | 791 | (format-time-string "%Y-%m-%d" (aref rda 1)) |
| 792 | " " | 792 | " " |
| 793 | (aref rda 0) | 793 | (aref rda 0) |
| @@ -811,7 +811,7 @@ Optional arg REVISION is a revision to annotate from." | |||
| 811 | "Return the current time, based at midnight of the current day, and | 811 | "Return the current time, based at midnight of the current day, and |
| 812 | encoded as fractional days." | 812 | encoded as fractional days." |
| 813 | (vc-annotate-convert-time | 813 | (vc-annotate-convert-time |
| 814 | (apply 'encode-time 0 0 0 (nthcdr 3 (decode-time (current-time)))))) | 814 | (apply #'encode-time 0 0 0 (nthcdr 3 (decode-time (current-time)))))) |
| 815 | 815 | ||
| 816 | (defun vc-rcs-annotate-time () | 816 | (defun vc-rcs-annotate-time () |
| 817 | "Return the time of the next annotation (as fraction of days) | 817 | "Return the time of the next annotation (as fraction of days) |
| @@ -935,7 +935,7 @@ Uses `rcs2log' which only works for RCS and CVS." | |||
| 935 | (unwind-protect | 935 | (unwind-protect |
| 936 | (progn | 936 | (progn |
| 937 | (setq default-directory odefault) | 937 | (setq default-directory odefault) |
| 938 | (if (eq 0 (apply 'call-process vc-rcs-rcs2log-program | 938 | (if (eq 0 (apply #'call-process vc-rcs-rcs2log-program |
| 939 | nil (list t tempfile) nil | 939 | nil (list t tempfile) nil |
| 940 | "-c" changelog | 940 | "-c" changelog |
| 941 | "-u" (concat login-name | 941 | "-u" (concat login-name |
| @@ -1340,11 +1340,10 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension." | |||
| 1340 | (to-one@ () (setq @-holes nil | 1340 | (to-one@ () (setq @-holes nil |
| 1341 | b (progn (search-forward "@") (point)) | 1341 | b (progn (search-forward "@") (point)) |
| 1342 | e (progn (while (and (search-forward "@") | 1342 | e (progn (while (and (search-forward "@") |
| 1343 | (= ?@ (char-after)) | 1343 | (= ?@ (char-after))) |
| 1344 | (progn | 1344 | (push (point) @-holes) |
| 1345 | (push (point) @-holes) | 1345 | (forward-char 1) |
| 1346 | (forward-char 1) | 1346 | (push (point) @-holes)) |
| 1347 | (push (point) @-holes)))) | ||
| 1348 | (1- (point))))) | 1347 | (1- (point))))) |
| 1349 | (tok+val (set-b+e name &optional proc) | 1348 | (tok+val (set-b+e name &optional proc) |
| 1350 | (unless (eq name (setq tok (read buffer))) | 1349 | (unless (eq name (setq tok (read buffer))) |
| @@ -1355,18 +1354,18 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension." | |||
| 1355 | (funcall proc) | 1354 | (funcall proc) |
| 1356 | (buffer-substring-no-properties b e)))) | 1355 | (buffer-substring-no-properties b e)))) |
| 1357 | (k-semi (name &optional proc) (tok+val #'to-semi name proc)) | 1356 | (k-semi (name &optional proc) (tok+val #'to-semi name proc)) |
| 1358 | (gather () (let ((pairs `(,e ,@@-holes ,b)) | 1357 | (gather (b e @-holes) |
| 1359 | acc) | 1358 | (let ((pairs `(,e ,@@-holes ,b)) |
| 1360 | (while pairs | 1359 | acc) |
| 1361 | (push (buffer-substring-no-properties | 1360 | (while pairs |
| 1362 | (cadr pairs) (car pairs)) | 1361 | (push (buffer-substring-no-properties |
| 1363 | acc) | 1362 | (cadr pairs) (car pairs)) |
| 1364 | (setq pairs (cddr pairs))) | 1363 | acc) |
| 1365 | (apply 'concat acc))) | 1364 | (setq pairs (cddr pairs))) |
| 1366 | (k-one@ (name &optional later) (tok+val #'to-one@ name | 1365 | (apply #'concat acc))) |
| 1367 | (if later | 1366 | (gather1 () (gather b e @-holes)) |
| 1368 | (lambda () t) | 1367 | (k-one@ (name &optional later) |
| 1369 | #'gather)))) | 1368 | (tok+val #'to-one@ name (if later (lambda () t) #'gather1)))) |
| 1370 | (save-excursion | 1369 | (save-excursion |
| 1371 | (goto-char (point-min)) | 1370 | (goto-char (point-min)) |
| 1372 | ;; headers | 1371 | ;; headers |
| @@ -1413,7 +1412,7 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension." | |||
| 1413 | ;; same algorithm used in RCS 5.7. | 1412 | ;; same algorithm used in RCS 5.7. |
| 1414 | (when (< (car ls) 100) | 1413 | (when (< (car ls) 100) |
| 1415 | (setcar ls (+ 1900 (car ls)))) | 1414 | (setcar ls (+ 1900 (car ls)))) |
| 1416 | (apply 'encode-time (nreverse ls))))) | 1415 | (apply #'encode-time (nreverse ls))))) |
| 1417 | ,@(mapcar #'k-semi '(author state)) | 1416 | ,@(mapcar #'k-semi '(author state)) |
| 1418 | ,(k-semi 'branches | 1417 | ,(k-semi 'branches |
| 1419 | (lambda () | 1418 | (lambda () |
| @@ -1444,9 +1443,10 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension." | |||
| 1444 | ;; only the former since it behaves identically to the | 1443 | ;; only the former since it behaves identically to the |
| 1445 | ;; latter in the absence of "@@".) | 1444 | ;; latter in the absence of "@@".) |
| 1446 | sub) | 1445 | sub) |
| 1447 | (cl-flet ((incg (_beg end) | 1446 | (cl-flet ((incg (beg end) |
| 1448 | (let ((e end) @-holes) | 1447 | (let ((b beg) (e end) @-holes) |
| 1449 | (while (and asc (< (car asc) e)) | 1448 | (while (and asc (< (car asc) e)) |
| 1449 | (push (pop asc) @-holes) | ||
| 1450 | (push (pop asc) @-holes)) | 1450 | (push (pop asc) @-holes)) |
| 1451 | ;; Self-deprecate when work is done. | 1451 | ;; Self-deprecate when work is done. |
| 1452 | ;; Folding many dimensions into one. | 1452 | ;; Folding many dimensions into one. |
| @@ -1454,7 +1454,7 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension." | |||
| 1454 | ;; O beauteous math! --the Unvexed Bum | 1454 | ;; O beauteous math! --the Unvexed Bum |
| 1455 | (unless asc | 1455 | (unless asc |
| 1456 | (setq sub #'buffer-substring-no-properties)) | 1456 | (setq sub #'buffer-substring-no-properties)) |
| 1457 | (gather)))) | 1457 | (gather b e @-holes)))) |
| 1458 | (while (and (sw) | 1458 | (while (and (sw) |
| 1459 | (not (eobp)) | 1459 | (not (eobp)) |
| 1460 | (setq context (to-eol) | 1460 | (setq context (to-eol) |
| @@ -1470,7 +1470,7 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension." | |||
| 1470 | ;; other revisions, replace the `text' tag+value with `:insn' | 1470 | ;; other revisions, replace the `text' tag+value with `:insn' |
| 1471 | ;; plus value, always scanning in-place. | 1471 | ;; plus value, always scanning in-place. |
| 1472 | (if (string= context (cdr (assq 'head headers))) | 1472 | (if (string= context (cdr (assq 'head headers))) |
| 1473 | (setcdr (cadr rev) (gather)) | 1473 | (setcdr (cadr rev) (gather b e @-holes)) |
| 1474 | (if @-holes | 1474 | (if @-holes |
| 1475 | (setq asc (nreverse @-holes) | 1475 | (setq asc (nreverse @-holes) |
| 1476 | sub #'incg) | 1476 | sub #'incg) |