diff options
| author | Stefan Monnier <monnier@iro.umontreal.ca> | 2012-07-10 07:51:54 -0400 |
|---|---|---|
| committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2012-07-10 07:51:54 -0400 |
| commit | f58e0fd503567288bb30e243595acaa589034929 (patch) | |
| tree | e40cb0a5c087c0af4bdd41948d655358b0fcd56e /lisp/vc | |
| parent | dfa96edd13d1db4a90fa0977d06b6bdeab2f642e (diff) | |
| download | emacs-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.el | 72 | ||||
| -rw-r--r-- | lisp/vc/diff-mode.el | 191 | ||||
| -rw-r--r-- | lisp/vc/diff.el | 2 | ||||
| -rw-r--r-- | lisp/vc/log-edit.el | 1 | ||||
| -rw-r--r-- | lisp/vc/log-view.el | 1 | ||||
| -rw-r--r-- | lisp/vc/pcvs-defs.el | 1 | ||||
| -rw-r--r-- | lisp/vc/pcvs-info.el | 38 | ||||
| -rw-r--r-- | lisp/vc/pcvs-parse.el | 12 | ||||
| -rw-r--r-- | lisp/vc/pcvs-util.el | 24 | ||||
| -rw-r--r-- | lisp/vc/pcvs.el | 74 | ||||
| -rw-r--r-- | lisp/vc/smerge-mode.el | 18 |
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) |
