aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2013-11-05 10:27:51 -0500
committerStefan Monnier2013-11-05 10:27:51 -0500
commit0acfafef3adde5bc0228eb16d7ab4b3fbfe3bf20 (patch)
tree122d277785b3ba7c59fb0d9a40827edd2ed6e8d9
parenta213a54163278b3b2598255cc913825539a119fe (diff)
downloademacs-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/ChangeLog3
-rw-r--r--lisp/vc/vc-rcs.el60
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 @@
12013-11-05 Stefan Monnier <monnier@iro.umontreal.ca> 12013-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
52013-11-05 Michael Albinus <michael.albinus@gmx.de> 82013-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
812encoded as fractional days." 812encoded 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)