summaryrefslogtreecommitdiff
path: root/lisp/vc
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2012-07-10 07:51:54 -0400
committerStefan Monnier <monnier@iro.umontreal.ca>2012-07-10 07:51:54 -0400
commitf58e0fd503567288bb30e243595acaa589034929 (patch)
treee40cb0a5c087c0af4bdd41948d655358b0fcd56e /lisp/vc
parentdfa96edd13d1db4a90fa0977d06b6bdeab2f642e (diff)
downloademacs-f58e0fd503567288bb30e243595acaa589034929.tar.gz
Reduce use of (require 'cl).
* admin/bzrmerge.el: Use cl-lib. * leim/quail/hangul.el: Don't require CL. * leim/quail/ipa.el: Use cl-lib. * vc/smerge-mode.el, vc/pcvs.el, vc/pcvs-util.el, vc/pcvs-info.el: * vc/diff-mode.el, vc/cvs-status.el, uniquify.el, scroll-bar.el: * register.el, progmodes/sh-script.el, net/gnutls.el, net/dbus.el: * msb.el, mpc.el, minibuffer.el, international/ucs-normalize.el: * international/quail.el, info-xref.el, imenu.el, image-mode.el: * font-lock.el, filesets.el, edmacro.el, doc-view.el, bookmark.el: * battery.el, avoid.el, abbrev.el: Use cl-lib. * vc/pcvs-parse.el, vc/pcvs-defs.el, vc/log-view.el, vc/log-edit.el: * vc/diff.el, simple.el, pcomplete.el, lpr.el, comint.el, loadhist.el: * jit-lock.el, international/iso-ascii.el, info.el, frame.el, bs.el: * emulation/crisp.el, electric.el, dired.el, cus-dep.el, composite.el: * calculator.el, autorevert.el, apropos.el: Don't require CL. * emacs-bytecomp.el (byte-recompile-directory, display-call-tree) (byte-compile-unfold-bcf, byte-compile-check-variable): * emacs-byte-opt.el (byte-compile-trueconstp) (byte-compile-nilconstp): * emacs-autoload.el (make-autoload): Use pcase. * face-remap.el (text-scale-adjust): Simplify pcase patterns.
Diffstat (limited to 'lisp/vc')
-rw-r--r--lisp/vc/cvs-status.el72
-rw-r--r--lisp/vc/diff-mode.el191
-rw-r--r--lisp/vc/diff.el2
-rw-r--r--lisp/vc/log-edit.el1
-rw-r--r--lisp/vc/log-view.el1
-rw-r--r--lisp/vc/pcvs-defs.el1
-rw-r--r--lisp/vc/pcvs-info.el38
-rw-r--r--lisp/vc/pcvs-parse.el12
-rw-r--r--lisp/vc/pcvs-util.el24
-rw-r--r--lisp/vc/pcvs.el74
-rw-r--r--lisp/vc/smerge-mode.el18
11 files changed, 217 insertions, 217 deletions
diff --git a/lisp/vc/cvs-status.el b/lisp/vc/cvs-status.el
index f803cc43441..6c6b18a605d 100644
--- a/lisp/vc/cvs-status.el
+++ b/lisp/vc/cvs-status.el
@@ -28,7 +28,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'pcvs-util)
;;;
@@ -165,7 +165,7 @@
;; Tagelt, tag element
;;
-(defstruct (cvs-tag
+(cl-defstruct (cvs-tag
(:constructor nil)
(:constructor cvs-tag-make
(vlist &optional name type))
@@ -235,9 +235,9 @@ The tree will be printed no closer than column COLUMN."
(save-excursion
(or (= (forward-line 1) 0) (insert "\n"))
(cvs-tree-print rest printer column))))
- (assert (>= prefix column))
+ (cl-assert (>= prefix column))
(move-to-column prefix t)
- (assert (eolp))
+ (cl-assert (eolp))
(insert (cvs-car name))
(dolist (br (cvs-cdr rev))
(let* ((column (current-column))
@@ -258,7 +258,7 @@ The tree will be printed no closer than column COLUMN."
(defun cvs-tree-merge (tree1 tree2)
"Merge tags trees TREE1 and TREE2 into one.
BEWARE: because of stability issues, this is not a symmetric operation."
- (assert (and (listp tree1) (listp tree2)))
+ (cl-assert (and (listp tree1) (listp tree2)))
(cond
((null tree1) tree2)
((null tree2) tree1)
@@ -273,10 +273,10 @@ BEWARE: because of stability issues, this is not a symmetric operation."
(l2 (length vl2)))
(cond
((= l1 l2)
- (case (cvs-tag-compare tag1 tag2)
- (more1 (list* rev2 (cvs-tree-merge tree1 (cdr tree2))))
- (more2 (list* rev1 (cvs-tree-merge (cdr tree1) tree2)))
- (equal
+ (pcase (cvs-tag-compare tag1 tag2)
+ (`more1 (cons rev2 (cvs-tree-merge tree1 (cdr tree2))))
+ (`more2 (cons rev1 (cvs-tree-merge (cdr tree1) tree2)))
+ (`equal
(cons (cons (cvs-tag-merge tag1 tag2)
(cvs-tree-merge (cvs-cdr rev1) (cvs-cdr rev2)))
(cvs-tree-merge (cdr tree1) (cdr tree2))))))
@@ -399,35 +399,35 @@ the list is a three-string list TAG, KIND, REV."
Otherwise, default to ASCII chars like +, - and |.")
(defconst cvs-tree-char-space
- (case cvs-tree-use-charset
- (jisx0208 (make-char 'japanese-jisx0208 33 33))
- (unicode " ")
- (t " ")))
+ (pcase cvs-tree-use-charset
+ (`jisx0208 (make-char 'japanese-jisx0208 33 33))
+ (`unicode " ")
+ (_ " ")))
(defconst cvs-tree-char-hbar
- (case cvs-tree-use-charset
- (jisx0208 (make-char 'japanese-jisx0208 40 44))
- (unicode "━")
- (t "--")))
+ (pcase cvs-tree-use-charset
+ (`jisx0208 (make-char 'japanese-jisx0208 40 44))
+ (`unicode "━")
+ (_ "--")))
(defconst cvs-tree-char-vbar
- (case cvs-tree-use-charset
- (jisx0208 (make-char 'japanese-jisx0208 40 45))
- (unicode "┃")
- (t "| ")))
+ (pcase cvs-tree-use-charset
+ (`jisx0208 (make-char 'japanese-jisx0208 40 45))
+ (`unicode "┃")
+ (_ "| ")))
(defconst cvs-tree-char-branch
- (case cvs-tree-use-charset
- (jisx0208 (make-char 'japanese-jisx0208 40 50))
- (unicode "┣")
- (t "+-")))
+ (pcase cvs-tree-use-charset
+ (`jisx0208 (make-char 'japanese-jisx0208 40 50))
+ (`unicode "┣")
+ (_ "+-")))
(defconst cvs-tree-char-eob ;end of branch
- (case cvs-tree-use-charset
- (jisx0208 (make-char 'japanese-jisx0208 40 49))
- (unicode "┗")
- (t "`-")))
+ (pcase cvs-tree-use-charset
+ (`jisx0208 (make-char 'japanese-jisx0208 40 49))
+ (`unicode "┗")
+ (_ "`-")))
(defconst cvs-tree-char-bob ;beginning of branch
- (case cvs-tree-use-charset
- (jisx0208 (make-char 'japanese-jisx0208 40 51))
- (unicode "┳")
- (t "+-")))
+ (pcase cvs-tree-use-charset
+ (`jisx0208 (make-char 'japanese-jisx0208 40 51))
+ (`unicode "┳")
+ (_ "+-")))
(defun cvs-tag-lessp (tag1 tag2)
(eq (cvs-tag-compare tag1 tag2) 'more2))
@@ -485,9 +485,9 @@ Optional prefix ARG chooses between two representations."
(pe t) ;"prev equal"
(nas nil)) ;"next afters" to be returned
(insert " ")
- (do* ((vs vlist (cdr vs))
- (ps prev (cdr ps))
- (as after (cdr as)))
+ (cl-do* ((vs vlist (cdr vs))
+ (ps prev (cdr ps))
+ (as after (cdr as)))
((and (null as) (null vs) (null ps))
(let ((revname (cvs-status-vl-to-str vlist)))
(if (cvs-every 'identity (cvs-map 'equal prev vlist))
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 9034ffe520f..a9d124700b8 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -53,7 +53,7 @@
;; - Handle `diff -b' output in context->unified.
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defvar add-log-buffer-file-name-function)
@@ -493,14 +493,15 @@ See http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01990.html")
;; We may have a first evaluation of `end' thanks to the hunk header.
(unless end
(setq end (and (re-search-forward
- (case style
- (unified (concat (if diff-valid-unified-empty-line
- "^[^-+# \\\n]\\|" "^[^-+# \\]\\|")
- ;; A `unified' header is ambiguous.
- diff-file-header-re))
- (context "^[^-+#! \\]")
- (normal "^[^<>#\\]")
- (t "^[^-+#!<> \\]"))
+ (pcase style
+ (`unified
+ (concat (if diff-valid-unified-empty-line
+ "^[^-+# \\\n]\\|" "^[^-+# \\]\\|")
+ ;; A `unified' header is ambiguous.
+ diff-file-header-re))
+ (`context "^[^-+#! \\]")
+ (`normal "^[^<>#\\]")
+ (_ "^[^-+#!<> \\]"))
nil t)
(match-beginning 0)))
(when diff-valid-unified-empty-line
@@ -710,7 +711,7 @@ data such as \"Index: ...\" and such."
(save-excursion
(let ((n 0))
(goto-char start)
- (while (re-search-forward re end t) (incf n))
+ (while (re-search-forward re end t) (cl-incf n))
n)))
(defun diff-splittable-p ()
@@ -834,16 +835,16 @@ PREFIX is only used internally: don't use it."
;; use any previously used preference
(cdr (assoc fs diff-remembered-files-alist))
;; try to be clever and use previous choices as an inspiration
- (dolist (rf diff-remembered-files-alist)
+ (cl-dolist (rf diff-remembered-files-alist)
(let ((newfile (diff-merge-strings (caar rf) (car fs) (cdr rf))))
- (if (and newfile (file-exists-p newfile)) (return newfile))))
+ (if (and newfile (file-exists-p newfile)) (cl-return newfile))))
;; look for each file in turn. If none found, try again but
;; ignoring the first level of directory, ...
- (do* ((files fs (delq nil (mapcar 'diff-filename-drop-dir files)))
- (file nil nil))
+ (cl-do* ((files fs (delq nil (mapcar 'diff-filename-drop-dir files)))
+ (file nil nil))
((or (null files)
- (setq file (do* ((files files (cdr files))
- (file (car files) (car files)))
+ (setq file (cl-do* ((files files (cdr files))
+ (file (car files) (car files)))
;; Use file-regular-p to avoid
;; /dev/null, directories, etc.
((or (null file) (file-regular-p file))
@@ -862,7 +863,7 @@ PREFIX is only used internally: don't use it."
(diff-find-file-name old noprompt (match-string 1)))
;; if all else fails, ask the user
(unless noprompt
- (let ((file (expand-file-name (or (first fs) ""))))
+ (let ((file (expand-file-name (or (car fs) ""))))
(setq file
(read-file-name (format "Use file %s: " file)
(file-name-directory file) file t
@@ -940,21 +941,23 @@ else cover the whole buffer."
(let ((modif nil) last-pt)
(while (progn (setq last-pt (point))
(= (forward-line -1) 0))
- (case (char-after)
+ (pcase (char-after)
(?\s (insert " ") (setq modif nil) (backward-char 1))
(?+ (delete-region (point) last-pt) (setq modif t))
(?- (if (not modif)
- (progn (forward-char 1)
- (insert " "))
- (delete-char 1)
- (insert "! "))
- (backward-char 2))
+ (progn (forward-char 1)
+ (insert " "))
+ (delete-char 1)
+ (insert "! "))
+ (backward-char 2))
(?\\ (when (save-excursion (forward-line -1)
- (= (char-after) ?+))
- (delete-region (point) last-pt) (setq modif t)))
+ (= (char-after) ?+))
+ (delete-region (point) last-pt)
+ (setq modif t)))
;; diff-valid-unified-empty-line.
- (?\n (insert " ") (setq modif nil) (backward-char 2))
- (t (setq modif nil))))))
+ (?\n (insert " ") (setq modif nil)
+ (backward-char 2))
+ (_ (setq modif nil))))))
(goto-char (point-max))
(save-excursion
(insert "--- " line2 ","
@@ -967,7 +970,8 @@ else cover the whole buffer."
(if (not (save-excursion (re-search-forward "^+" nil t)))
(delete-region (point) (point-max))
(let ((modif nil) (delete nil))
- (if (save-excursion (re-search-forward "^\\+.*\n-" nil t))
+ (if (save-excursion (re-search-forward "^\\+.*\n-"
+ nil t))
;; Normally, lines in a substitution come with
;; first the removals and then the additions, and
;; the context->unified function follows this
@@ -976,22 +980,22 @@ else cover the whole buffer."
;; context->unified as an undo command.
(setq reversible nil))
(while (not (eobp))
- (case (char-after)
+ (pcase (char-after)
(?\s (insert " ") (setq modif nil) (backward-char 1))
(?- (setq delete t) (setq modif t))
(?+ (if (not modif)
- (progn (forward-char 1)
- (insert " "))
- (delete-char 1)
- (insert "! "))
- (backward-char 2))
+ (progn (forward-char 1)
+ (insert " "))
+ (delete-char 1)
+ (insert "! "))
+ (backward-char 2))
(?\\ (when (save-excursion (forward-line 1)
- (not (eobp)))
- (setq delete t) (setq modif t)))
+ (not (eobp)))
+ (setq delete t) (setq modif t)))
;; diff-valid-unified-empty-line.
(?\n (insert " ") (setq modif nil) (backward-char 2)
(setq reversible nil))
- (t (setq modif nil)))
+ (_ (setq modif nil)))
(let ((last-pt (point)))
(forward-line 1)
(when delete
@@ -1051,17 +1055,18 @@ With a prefix argument, convert unified format to context format."
(goto-char pt1)
(forward-line 1)
(while (< (point) pt2)
- (case (char-after)
+ (pcase (char-after)
(?! (delete-char 2) (insert "-") (forward-line 1))
(?- (forward-char 1) (delete-char 1) (forward-line 1))
- (?\s ;merge with the other half of the chunk
+ (?\s ;merge with the other half of the chunk
(let* ((endline2
(save-excursion
(goto-char pt2) (forward-line 1) (point))))
- (case (char-after pt2)
- ((?! ?+)
+ (pcase (char-after pt2)
+ ((or ?! ?+)
(insert "+"
- (prog1 (buffer-substring (+ pt2 2) endline2)
+ (prog1
+ (buffer-substring (+ pt2 2) endline2)
(delete-region pt2 endline2))))
(?\s
(unless (= (- endline2 pt2)
@@ -1075,9 +1080,9 @@ With a prefix argument, convert unified format to context format."
(delete-char 1)
(forward-line 1))
(?\\ (forward-line 1))
- (t (setq reversible nil)
+ (_ (setq reversible nil)
(delete-char 1) (forward-line 1)))))
- (t (setq reversible nil) (forward-line 1))))
+ (_ (setq reversible nil) (forward-line 1))))
(while (looking-at "[+! ] ")
(if (/= (char-after) ?!) (forward-char 1)
(delete-char 1) (insert "+"))
@@ -1155,13 +1160,13 @@ else cover the whole buffer."
(replace-match "@@ -\\8 +\\7 @@" nil)
(forward-line 1)
(let ((c (char-after)) first last)
- (while (case (setq c (char-after))
+ (while (pcase (setq c (char-after))
(?- (setq first (or first (point)))
- (delete-char 1) (insert "+") t)
+ (delete-char 1) (insert "+") t)
(?+ (setq last (or last (point)))
- (delete-char 1) (insert "-") t)
- ((?\\ ?#) t)
- (t (when (and first last (< first last))
+ (delete-char 1) (insert "-") t)
+ ((or ?\\ ?#) t)
+ (_ (when (and first last (< first last))
(insert (delete-and-extract-region first last)))
(setq first nil last nil)
(memq c (if diff-valid-unified-empty-line
@@ -1184,13 +1189,13 @@ else cover the whole buffer."
(concat diff-hunk-header-re-unified
"\\|[-*][-*][-*] [0-9,]+ [-*][-*][-*][-*]$"
"\\|--- .+\n\\+\\+\\+ ")))
- (case (char-after)
- (?\s (incf space))
- (?+ (incf plus))
- (?- (incf minus))
- (?! (incf bang))
- ((?\\ ?#) nil)
- (t (setq space 0 plus 0 minus 0 bang 0)))
+ (pcase (char-after)
+ (?\s (cl-incf space))
+ (?+ (cl-incf plus))
+ (?- (cl-incf minus))
+ (?! (cl-incf bang))
+ ((or ?\\ ?#) nil)
+ (_ (setq space 0 plus 0 minus 0 bang 0)))
(cond
((looking-at diff-hunk-header-re-unified)
(let* ((old1 (match-string 2))
@@ -1432,7 +1437,7 @@ Only works for unified diffs."
(cond
((and (memq (char-after) '(?\s ?! ?+ ?-))
(memq (char-after (1+ (point))) '(?\s ?\t)))
- (decf count) t)
+ (cl-decf count) t)
((or (zerop count) (= count lines)) nil)
((memq (char-after) '(?! ?+ ?-))
(if (not (and (eq (char-after (1+ (point))) ?\n)
@@ -1483,8 +1488,8 @@ Only works for unified diffs."
(after (string-to-number (or (match-string 4) "1"))))
(forward-line)
(while
- (case (char-after)
- (?\s (decf before) (decf after) t)
+ (pcase (char-after)
+ (?\s (cl-decf before) (cl-decf after) t)
(?-
(if (and (looking-at diff-file-header-re)
(zerop before) (zerop after))
@@ -1494,15 +1499,15 @@ Only works for unified diffs."
;; line so that our code which doesn't count lines
;; will not get confused.
(progn (save-excursion (insert "\n")) nil)
- (decf before) t))
- (?+ (decf after) t)
- (t
+ (cl-decf before) t))
+ (?+ (cl-decf after) t)
+ (_
(cond
((and diff-valid-unified-empty-line
;; Not just (eolp) so we don't infloop at eob.
(eq (char-after) ?\n)
(> before 0) (> after 0))
- (decf before) (decf after) t)
+ (cl-decf before) (cl-decf after) t)
((and (zerop before) (zerop after)) nil)
((or (< before 0) (< after 0))
(error (if (or (zerop before) (zerop after))
@@ -1719,16 +1724,17 @@ the value of this variable when given an appropriate prefix argument).
With a prefix argument, REVERSE the hunk."
(interactive "P")
- (destructuring-bind (buf line-offset pos old new &optional switched)
- ;; Sometimes we'd like to have the following behavior: if REVERSE go
- ;; to the new file, otherwise go to the old. But that means that by
- ;; default we use the old file, which is the opposite of the default
- ;; for diff-goto-source, and is thus confusing. Also when you don't
- ;; know about it it's pretty surprising.
- ;; TODO: make it possible to ask explicitly for this behavior.
- ;;
- ;; This is duplicated in diff-test-hunk.
- (diff-find-source-location nil reverse)
+ (pcase-let ((`(,buf ,line-offset ,pos ,old ,new ,switched)
+ ;; Sometimes we'd like to have the following behavior: if
+ ;; REVERSE go to the new file, otherwise go to the old.
+ ;; But that means that by default we use the old file, which is
+ ;; the opposite of the default for diff-goto-source, and is thus
+ ;; confusing. Also when you don't know about it it's
+ ;; pretty surprising.
+ ;; TODO: make it possible to ask explicitly for this behavior.
+ ;;
+ ;; This is duplicated in diff-test-hunk.
+ (diff-find-source-location nil reverse)))
(cond
((null line-offset)
(error "Can't find the text to patch"))
@@ -1771,8 +1777,8 @@ With a prefix argument, REVERSE the hunk."
"See whether it's possible to apply the current hunk.
With a prefix argument, try to REVERSE the hunk."
(interactive "P")
- (destructuring-bind (buf line-offset pos src _dst &optional switched)
- (diff-find-source-location nil reverse)
+ (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched)
+ (diff-find-source-location nil reverse)))
(set-window-point (display-buffer buf) (+ (car pos) (cdr src)))
(diff-hunk-status-msg line-offset (diff-xor reverse switched) t)))
@@ -1791,8 +1797,8 @@ then `diff-jump-to-old-file' is also set, for the next invocations."
;; This is a convenient detail when using smerge-diff.
(if event (posn-set-point (event-end event)))
(let ((rev (not (save-excursion (beginning-of-line) (looking-at "[-<]")))))
- (destructuring-bind (buf line-offset pos src _dst &optional switched)
- (diff-find-source-location other-file rev)
+ (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched)
+ (diff-find-source-location other-file rev)))
(pop-to-buffer buf)
(goto-char (+ (car pos) (cdr src)))
(diff-hunk-status-msg line-offset (diff-xor rev switched) t))))
@@ -1809,10 +1815,11 @@ For use in `add-log-current-defun-function'."
(when (looking-at diff-hunk-header-re)
(forward-line 1)
(re-search-forward "^[^ ]" nil t))
- (destructuring-bind (&optional buf _line-offset pos src dst switched)
- ;; Use `noprompt' since this is used in which-func-mode and such.
- (ignore-errors ;Signals errors in place of prompting.
- (diff-find-source-location nil nil 'noprompt))
+ (pcase-let ((`(,buf ,_line-offset ,pos ,src ,dst ,switched)
+ (ignore-errors ;Signals errors in place of prompting.
+ ;; Use `noprompt' since this is used in which-func-mode
+ ;; and such.
+ (diff-find-source-location nil nil 'noprompt))))
(when buf
(beginning-of-line)
(or (when (memq (char-after) '(?< ?-))
@@ -1835,7 +1842,7 @@ For use in `add-log-current-defun-function'."
"Re-diff the current hunk, ignoring whitespace differences."
(interactive)
(let* ((char-offset (- (point) (diff-beginning-of-hunk t)))
- (opts (case (char-after) (?@ "-bu") (?* "-bc") (t "-b")))
+ (opts (pcase (char-after) (?@ "-bu") (?* "-bc") (_ "-b")))
(line-nb (and (or (looking-at "[^0-9]+\\([0-9]+\\)")
(error "Can't find line number"))
(string-to-number (match-string 1))))
@@ -1857,13 +1864,13 @@ For use in `add-log-current-defun-function'."
(let ((status
(call-process diff-command nil t nil
opts file1 file2)))
- (case status
- (0 nil) ;Nothing to reformat.
+ (pcase status
+ (0 nil) ;Nothing to reformat.
(1 (goto-char (point-min))
- ;; Remove the file-header.
- (when (re-search-forward diff-hunk-header-re nil t)
- (delete-region (point-min) (match-beginning 0))))
- (t (goto-char (point-max))
+ ;; Remove the file-header.
+ (when (re-search-forward diff-hunk-header-re nil t)
+ (delete-region (point-min) (match-beginning 0))))
+ (_ (goto-char (point-max))
(unless (bolp) (insert "\n"))
(insert hunk)))
(setq hunk (buffer-string))
@@ -1942,14 +1949,14 @@ For use in `add-log-current-defun-function'."
(remove-overlays beg end 'diff-mode 'fine)
(goto-char beg)
- (case style
- (unified
+ (pcase style
+ (`unified
(while (re-search-forward "^\\(?:-.*\n\\)+\\(\\)\\(?:\\+.*\n\\)+"
end t)
(smerge-refine-subst (match-beginning 0) (match-end 1)
(match-end 1) (match-end 0)
nil 'diff-refine-preproc props-r props-a)))
- (context
+ (`context
(let* ((middle (save-excursion (re-search-forward "^---")))
(other middle))
(while (re-search-forward "^\\(?:!.*\n\\)+" middle t)
@@ -1964,7 +1971,7 @@ For use in `add-log-current-defun-function'."
'diff-refine-preproc
(unless diff-use-changed-face props-r)
(unless diff-use-changed-face props-a)))))
- (t ;; Normal diffs.
+ (_ ;; Normal diffs.
(let ((beg1 (1+ (point))))
(when (re-search-forward "^---.*\n" end t)
;; It's a combined add&remove, so there's something to do.
diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el
index 6cfee52cbb5..b70b6cd919c 100644
--- a/lisp/vc/diff.el
+++ b/lisp/vc/diff.el
@@ -32,8 +32,6 @@
(declare-function diff-setup-whitespace "diff-mode" ())
-(eval-when-compile (require 'cl))
-
(defgroup diff nil
"Comparing files with `diff'."
:group 'tools)
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index 5ecd5c44b2e..5ae311222ba 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -29,7 +29,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'add-log) ; for all the ChangeLog goodies
(require 'pcvs-util)
(require 'ring)
diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el
index d345a20a0f5..07526b4fba6 100644
--- a/lisp/vc/log-view.el
+++ b/lisp/vc/log-view.el
@@ -109,7 +109,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'pcvs-util)
(autoload 'vc-find-revision "vc")
(autoload 'vc-diff-internal "vc")
diff --git a/lisp/vc/pcvs-defs.el b/lisp/vc/pcvs-defs.el
index ab45b313bd5..0f71b7b82e7 100644
--- a/lisp/vc/pcvs-defs.el
+++ b/lisp/vc/pcvs-defs.el
@@ -26,7 +26,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'pcvs-util)
;;;; -------------------------------------------------------
diff --git a/lisp/vc/pcvs-info.el b/lisp/vc/pcvs-info.el
index 4f8c114d721..36572640cfc 100644
--- a/lisp/vc/pcvs-info.el
+++ b/lisp/vc/pcvs-info.el
@@ -31,7 +31,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'pcvs-util)
;;(require 'pcvs-defs)
@@ -146,7 +146,7 @@ to confuse some users sometimes."
;; Constructor:
-(defstruct (cvs-fileinfo
+(cl-defstruct (cvs-fileinfo
(:constructor nil)
(:copier nil)
(:constructor -cvs-create-fileinfo (type dir file full-log
@@ -274,10 +274,10 @@ to confuse some users sometimes."
(string= file (file-name-nondirectory file)))
(setq check 'type) (symbolp type)
(setq check 'consistency)
- (case type
- (DIRCHANGE (and (null subtype) (string= "." file)))
- ((NEED-UPDATE ADDED MISSING DEAD MODIFIED MESSAGE UP-TO-DATE
- REMOVED NEED-MERGE CONFLICT UNKNOWN MESSAGE)
+ (pcase type
+ (`DIRCHANGE (and (null subtype) (string= "." file)))
+ ((or `NEED-UPDATE `ADDED `MISSING `DEAD `MODIFIED `MESSAGE
+ `UP-TO-DATE `REMOVED `NEED-MERGE `CONFLICT `UNKNOWN)
t)))
fi
(error "Invalid :%s in cvs-fileinfo %s" check fi))))
@@ -325,9 +325,9 @@ FI-OR-TYPE can either be a symbol (a fileinfo-type) or a fileinfo."
(defun cvs-add-face (str face &optional keymap &rest props)
(when keymap
(when (keymapp keymap)
- (setq props (list* 'keymap keymap props)))
- (setq props (list* 'mouse-face 'highlight props)))
- (add-text-properties 0 (length str) (list* 'font-lock-face face props) str)
+ (setq props `(keymap ,keymap ,@props)))
+ (setq props `(mouse-face highlight ,@props)))
+ (add-text-properties 0 (length str) `(font-lock-face ,face ,@props) str)
str)
(defun cvs-fileinfo-pp (fileinfo)
@@ -337,15 +337,15 @@ For use by the cookie package."
(let ((type (cvs-fileinfo->type fileinfo))
(subtype (cvs-fileinfo->subtype fileinfo)))
(insert
- (case type
- (DIRCHANGE (concat "In directory "
- (cvs-add-face (cvs-fileinfo->full-name fileinfo)
- 'cvs-header t 'cvs-goal-column t)
- ":"))
- (MESSAGE
+ (pcase type
+ (`DIRCHANGE (concat "In directory "
+ (cvs-add-face (cvs-fileinfo->full-name fileinfo)
+ 'cvs-header t 'cvs-goal-column t)
+ ":"))
+ (`MESSAGE
(cvs-add-face (format "Message: %s" (cvs-fileinfo->full-log fileinfo))
'cvs-msg))
- (t
+ (_
(let* ((status (if (cvs-fileinfo->marked fileinfo)
(cvs-add-face "*" 'cvs-marked)
" "))
@@ -354,10 +354,10 @@ For use by the cookie package."
(base (or (cvs-fileinfo->base-rev fileinfo) ""))
(head (cvs-fileinfo->head-rev fileinfo))
(type
- (let ((str (case type
+ (let ((str (pcase type
;;(MOD-CONFLICT "Not Removed")
- (DEAD "")
- (t (capitalize (symbol-name type)))))
+ (`DEAD "")
+ (_ (capitalize (symbol-name type)))))
(face (let ((sym (intern
(concat "cvs-fi-"
(downcase (symbol-name type))
diff --git a/lisp/vc/pcvs-parse.el b/lisp/vc/pcvs-parse.el
index a588c735ce7..dd448b9d480 100644
--- a/lisp/vc/pcvs-parse.el
+++ b/lisp/vc/pcvs-parse.el
@@ -32,8 +32,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
(require 'pcvs-util)
(require 'pcvs-info)
@@ -117,7 +115,7 @@ If RE matches, advance the point until the line after the match and
then assign the variables as specified in MATCHES (via `setq')."
(cons 'cvs-do-match
(cons re (mapcar (lambda (match)
- `(cons ',(first match) ,(second match)))
+ `(cons ',(car match) ,(cadr match)))
matches))))
(defun cvs-do-match (re &rest matches)
@@ -150,8 +148,8 @@ Match RE and if successful, execute MATCHES."
(cvs-or
(funcall parse-spec)
- (dolist (re cvs-parse-ignored-messages)
- (when (cvs-match re) (return t)))
+ (cl-dolist (re cvs-parse-ignored-messages)
+ (when (cvs-match re) (cl-return t)))
;; This is a parse error. Create a message-type fileinfo.
(and
@@ -221,7 +219,7 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
;; ?: Unknown file.
(let ((code (aref c 0)))
(cvs-parsed-fileinfo
- (case code
+ (pcase code
(?M 'MODIFIED)
(?A 'ADDED)
(?R 'REMOVED)
@@ -238,7 +236,7 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
(if (re-search-forward "^<<<<<<< " nil t)
'CONFLICT 'NEED-MERGE))))
(?J 'NEED-MERGE) ;not supported by standard CVS
- ((?U ?P)
+ ((or ?U ?P)
(if dont-change-disc 'NEED-UPDATE
(cons 'UP-TO-DATE (if (eq code ?U) 'UPDATED 'PATCHED)))))
path 'trust)))
diff --git a/lisp/vc/pcvs-util.el b/lisp/vc/pcvs-util.el
index a3c525cb896..3d54bbd12a3 100644
--- a/lisp/vc/pcvs-util.el
+++ b/lisp/vc/pcvs-util.el
@@ -26,7 +26,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;;;
;;;; list processing
@@ -63,7 +63,7 @@
(while (and l (> n 1))
(setcdr nl (list (pop l)))
(setq nl (cdr nl))
- (decf n))
+ (cl-decf n))
ret))))
(defun cvs-partition (p l)
@@ -130,10 +130,10 @@ If NOREUSE is non-nil, always return a new buffer."
(if noreuse (generate-new-buffer name)
(get-buffer-create name)))
(unless noreuse
- (dolist (buf (buffer-list))
+ (cl-dolist (buf (buffer-list))
(with-current-buffer buf
(when (equal name list-buffers-directory)
- (return buf)))))
+ (cl-return buf)))))
(with-current-buffer (create-file-buffer name)
(setq list-buffers-directory name)
(current-buffer))))
@@ -195,10 +195,10 @@ arguments. If ARGS is not a list, no argument will be passed."
;;;; (interactive <foo>) support function
;;;;
-(defstruct (cvs-qtypedesc
- (:constructor nil) (:copier nil)
- (:constructor cvs-qtypedesc-create
- (str2obj obj2str &optional complete hist-sym require)))
+(cl-defstruct (cvs-qtypedesc
+ (:constructor nil) (:copier nil)
+ (:constructor cvs-qtypedesc-create
+ (str2obj obj2str &optional complete hist-sym require)))
str2obj
obj2str
hist-sym
@@ -231,10 +231,10 @@ arguments. If ARGS is not a list, no argument will be passed."
;;;; Flags handling
;;;;
-(defstruct (cvs-flags
- (:constructor nil)
- (:constructor -cvs-flags-make
- (desc defaults &optional qtypedesc hist-sym)))
+(cl-defstruct (cvs-flags
+ (:constructor nil)
+ (:constructor -cvs-flags-make
+ (desc defaults &optional qtypedesc hist-sym)))
defaults persist desc qtypedesc hist-sym)
(defmacro cvs-flags-define (sym defaults
diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el
index 0508f45149a..659151a31e9 100644
--- a/lisp/vc/pcvs.el
+++ b/lisp/vc/pcvs.el
@@ -118,7 +118,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'ewoc) ;Ewoc was once cookie
(require 'pcvs-defs)
(require 'pcvs-util)
@@ -219,21 +219,21 @@
(autoload 'cvs-status-get-tags "cvs-status")
(defun cvs-tags-list ()
"Return a list of acceptable tags, ready for completions."
- (assert (cvs-buffer-p))
+ (cl-assert (cvs-buffer-p))
(let ((marked (cvs-get-marked)))
- (list* '("BASE") '("HEAD")
- (when marked
- (with-temp-buffer
- (process-file cvs-program
- nil ;no input
- t ;output to current-buffer
- nil ;don't update display while running
- "status"
- "-v"
- (cvs-fileinfo->full-name (car marked)))
- (goto-char (point-min))
- (let ((tags (cvs-status-get-tags)))
- (when (listp tags) tags)))))))
+ `(("BASE") ("HEAD")
+ ,@(when marked
+ (with-temp-buffer
+ (process-file cvs-program
+ nil ;no input
+ t ;output to current-buffer
+ nil ;don't update display while running
+ "status"
+ "-v"
+ (cvs-fileinfo->full-name (car marked)))
+ (goto-char (point-min))
+ (let ((tags (cvs-status-get-tags)))
+ (when (listp tags) tags)))))))
(defvar cvs-tag-history nil)
(defconst cvs-qtypedesc-tag
@@ -426,16 +426,16 @@ If non-nil, NEW means to create a new buffer no matter what."
;; look for another cvs buffer visiting the same directory
(save-excursion
(unless new
- (dolist (buffer (cons (current-buffer) (buffer-list)))
+ (cl-dolist (buffer (cons (current-buffer) (buffer-list)))
(set-buffer buffer)
(and (cvs-buffer-p)
- (case cvs-reuse-cvs-buffer
- (always t)
- (subdir
+ (pcase cvs-reuse-cvs-buffer
+ (`always t)
+ (`subdir
(or (string-prefix-p default-directory dir)
(string-prefix-p dir default-directory)))
- (samedir (string= default-directory dir)))
- (return buffer)))))
+ (`samedir (string= default-directory dir)))
+ (cl-return buffer)))))
;; we really have to create a new buffer:
;; we temporarily bind cwd to "" to prevent
;; create-file-buffer from using directory info
@@ -478,7 +478,7 @@ If non-nil, NEW means to create a new buffer no matter what."
;;(set-buffer buf)
buffer))))))
-(defun* cvs-cmd-do (cmd dir flags fis new
+(cl-defun cvs-cmd-do (cmd dir flags fis new
&key cvsargs noexist dont-change-disc noshow)
(let* ((dir (file-name-as-directory
(abbreviate-file-name (expand-file-name dir))))
@@ -501,7 +501,7 @@ If non-nil, NEW means to create a new buffer no matter what."
;; cvsbuf))))
(defun cvs-run-process (args fis postprocess &optional single-dir)
- (assert (cvs-buffer-p cvs-buffer))
+ (cl-assert (cvs-buffer-p cvs-buffer))
(save-current-buffer
(let ((procbuf (current-buffer))
(cvsbuf cvs-buffer)
@@ -521,9 +521,9 @@ If non-nil, NEW means to create a new buffer no matter what."
(let ((inhibit-read-only t))
(insert "pcl-cvs: descending directory " dir "\n"))
;; loop to find the same-dir-elems
- (do* ((files () (cons (cvs-fileinfo->file fi) files))
- (fis fis (cdr fis))
- (fi (car fis) (car fis)))
+ (cl-do* ((files () (cons (cvs-fileinfo->file fi) files))
+ (fis fis (cdr fis))
+ (fi (car fis) (car fis)))
((not (and fis (string= dir (cvs-fileinfo->dir fi))))
(list dir files fis))))))
(dir (nth 0 dir+files+rest))
@@ -813,7 +813,7 @@ TIN specifies an optional starting point."
(while (and tin (cvs-fileinfo< fi (ewoc-data tin)))
(setq tin (ewoc-prev c tin)))
(if (null tin) (ewoc-enter-first c fi) ;empty collection
- (assert (not (cvs-fileinfo< fi (ewoc-data tin))))
+ (cl-assert (not (cvs-fileinfo< fi (ewoc-data tin))))
(let ((next-tin (ewoc-next c tin)))
(while (not (or (null next-tin)
(cvs-fileinfo< fi (ewoc-data next-tin))))
@@ -871,15 +871,15 @@ RM-MSGS if non-nil means remove messages."
(let* ((type (cvs-fileinfo->type fi))
(subtype (cvs-fileinfo->subtype fi))
(keep
- (case type
+ (pcase type
;; remove temp messages and keep the others
- (MESSAGE (not (or rm-msgs (eq subtype 'TEMP))))
+ (`MESSAGE (not (or rm-msgs (eq subtype 'TEMP))))
;; remove entries
- (DEAD nil)
+ (`DEAD nil)
;; handled also?
- (UP-TO-DATE (not rm-handled))
+ (`UP-TO-DATE (not rm-handled))
;; keep the rest
- (t (not (run-hook-with-args-until-success
+ (_ (not (run-hook-with-args-until-success
'cvs-cleanup-functions fi))))))
;; mark dirs for removal
@@ -1389,7 +1389,7 @@ an empty list if it doesn't point to a file at all."
fis))))
(nreverse fis)))
-(defun* cvs-mode-marked (filter &optional cmd
+(cl-defun cvs-mode-marked (filter &optional cmd
&key read-only one file noquery)
"Get the list of marked FIS.
CMD is used to determine whether to use the marks or not.
@@ -1474,7 +1474,7 @@ The POSTPROC specified there (typically `log-edit') is then called,
(let ((msg (buffer-substring-no-properties (point-min) (point-max))))
(cvs-mode!)
;;(pop-to-buffer cvs-buffer)
- (cvs-mode-do "commit" (list* "-m" msg flags) 'commit)))
+ (cvs-mode-do "commit" `("-m" ,msg ,@flags) 'commit)))
;;;; Editing existing commit log messages.
@@ -1604,7 +1604,7 @@ With prefix argument, prompt for cvs flags."
(or current-prefix-arg (not cvs-add-default-message)))
(read-from-minibuffer "Enter description: ")
(or cvs-add-default-message "")))
- (flags (list* "-m" msg flags))
+ (flags `("-m" ,msg ,@flags))
(postproc
;; setup postprocessing for the directory entries
(when dirs
@@ -1845,7 +1845,7 @@ Signal an error if there is no backup file."
(setq ret t)))
ret)))
-(defun* cvs-mode-run (cmd flags fis
+(cl-defun cvs-mode-run (cmd flags fis
&key (buf (cvs-temp-buffer))
dont-change-disc cvsargs postproc)
"Generic cvs-mode-<foo> function.
@@ -1887,7 +1887,7 @@ POSTPROC is a list of expressions to be evaluated at the very end (after
(cvs-run-process args fis postproc single-dir))))
-(defun* cvs-mode-do (cmd flags filter
+(cl-defun cvs-mode-do (cmd flags filter
&key show dont-change-disc cvsargs postproc)
"Generic cvs-mode-<foo> function.
Executes `cvs CVSARGS CMD FLAGS' on the selected files.
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index cf1cdabc80f..e6b63030fef 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -43,7 +43,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'diff-mode) ;For diff-auto-refine-mode.
(require 'newcomment)
@@ -716,7 +716,7 @@ major modes. Uses `smerge-resolve-function' to do the actual work."
(while (or (not (match-end i))
(< (point) (match-beginning i))
(>= (point) (match-end i)))
- (decf i))
+ (cl-decf i))
i))
(defun smerge-keep-current ()
@@ -779,7 +779,7 @@ An error is raised if not inside a conflict."
(filename (or (match-string 1) ""))
(_ (re-search-forward smerge-end-re))
- (_ (assert (< orig-point (match-end 0))))
+ (_ (cl-assert (< orig-point (match-end 0))))
(other-end (match-beginning 0))
(end (match-end 0))
@@ -1073,12 +1073,12 @@ used to replace chars to try and eliminate some spurious differences."
(forward-line 1) ;Skip hunk header.
(and (re-search-forward "^[0-9]" nil 'move) ;Skip hunk body.
(goto-char (match-beginning 0))))
- ;; (assert (or (null last1) (< (overlay-start last1) end1)))
- ;; (assert (or (null last2) (< (overlay-start last2) end2)))
+ ;; (cl-assert (or (null last1) (< (overlay-start last1) end1)))
+ ;; (cl-assert (or (null last2) (< (overlay-start last2) end2)))
(if smerge-refine-weight-hack
(progn
- ;; (assert (or (null last1) (<= (overlay-end last1) end1)))
- ;; (assert (or (null last2) (<= (overlay-end last2) end2)))
+ ;; (cl-assert (or (null last1) (<= (overlay-end last1) end1)))
+ ;; (cl-assert (or (null last2) (<= (overlay-end last2) end2)))
)
;; smerge-refine-forward-function when calling in chopup may
;; have stopped because it bumped into EOB whereas in
@@ -1290,8 +1290,8 @@ with a \\[universal-argument] prefix, makes up a 3-way conflict."
(progn (pop-mark) (mark))
(when current-prefix-arg (pop-mark) (mark))))
;; Start from the end so as to avoid problems with pos-changes.
- (destructuring-bind (pt1 pt2 pt3 &optional pt4)
- (sort (list* pt1 pt2 pt3 (if pt4 (list pt4))) '>=)
+ (pcase-let ((`(,pt1 ,pt2 ,pt3 ,pt4)
+ (sort `(,pt1 ,pt2 ,pt3 ,@(if pt4 (list pt4))) '>=)))
(goto-char pt1) (beginning-of-line)
(insert ">>>>>>> OTHER\n")
(goto-char pt2) (beginning-of-line)