aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2012-07-10 07:51:54 -0400
committerStefan Monnier2012-07-10 07:51:54 -0400
commitf58e0fd503567288bb30e243595acaa589034929 (patch)
treee40cb0a5c087c0af4bdd41948d655358b0fcd56e
parentdfa96edd13d1db4a90fa0977d06b6bdeab2f642e (diff)
downloademacs-f58e0fd503567288bb30e243595acaa589034929.tar.gz
emacs-f58e0fd503567288bb30e243595acaa589034929.zip
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
-rw-r--r--admin/ChangeLog34
-rw-r--r--admin/bzrmerge.el9
-rw-r--r--leim/ChangeLog6
-rw-r--r--leim/quail/hangul.el1
-rw-r--r--leim/quail/ipa.el18
-rw-r--r--lisp/ChangeLog20
-rw-r--r--lisp/abbrev.el13
-rw-r--r--lisp/apropos.el17
-rw-r--r--lisp/autorevert.el3
-rw-r--r--lisp/avoid.el34
-rw-r--r--lisp/battery.el11
-rw-r--r--lisp/bookmark.el14
-rw-r--r--lisp/bs.el10
-rw-r--r--lisp/calculator.el2
-rw-r--r--lisp/comint.el1
-rw-r--r--lisp/composite.el2
-rw-r--r--lisp/cus-dep.el1
-rw-r--r--lisp/dired.el2
-rw-r--r--lisp/doc-view.el30
-rw-r--r--lisp/edmacro.el168
-rw-r--r--lisp/electric.el10
-rw-r--r--lisp/emacs-lisp/autoload.el15
-rw-r--r--lisp/emacs-lisp/byte-opt.el12
-rw-r--r--lisp/emacs-lisp/bytecomp.el37
-rw-r--r--lisp/emulation/crisp.el4
-rw-r--r--lisp/face-remap.el6
-rw-r--r--lisp/filesets.el78
-rw-r--r--lisp/font-lock.el15
-rw-r--r--lisp/frame.el2
-rw-r--r--lisp/hexl.el2
-rw-r--r--lisp/image-mode.el17
-rw-r--r--lisp/imenu.el26
-rw-r--r--lisp/info-xref.el13
-rw-r--r--lisp/info.el2
-rw-r--r--lisp/international/iso-ascii.el12
-rw-r--r--lisp/international/quail.el8
-rw-r--r--lisp/international/ucs-normalize.el8
-rw-r--r--lisp/jit-lock.el2
-rw-r--r--lisp/loadhist.el14
-rw-r--r--lisp/lpr.el6
-rw-r--r--lisp/minibuffer.el134
-rw-r--r--lisp/mpc.el50
-rw-r--r--lisp/msb.el100
-rw-r--r--lisp/net/dbus.el21
-rw-r--r--lisp/net/gnutls.el4
-rw-r--r--lisp/pcomplete.el13
-rw-r--r--lisp/progmodes/sh-script.el45
-rw-r--r--lisp/register.el10
-rw-r--r--lisp/scroll-bar.el7
-rw-r--r--lisp/simple.el2
-rw-r--r--lisp/uniquify.el6
-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
62 files changed, 753 insertions, 758 deletions
diff --git a/admin/ChangeLog b/admin/ChangeLog
index 5ae49cd4b7a..6c5b1342d32 100644
--- a/admin/ChangeLog
+++ b/admin/ChangeLog
@@ -1,3 +1,7 @@
12012-07-10 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * bzrmerge.el: Use cl-lib.
4
12012-07-09 Paul Eggert <eggert@cs.ucla.edu> 52012-07-09 Paul Eggert <eggert@cs.ucla.edu>
2 6
3 Rename configure.in to configure.ac (Bug#11603). 7 Rename configure.in to configure.ac (Bug#11603).
@@ -30,8 +34,8 @@
30 * coccinelle: New subdirectory 34 * coccinelle: New subdirectory
31 * coccinelle/README: Documentation stub. 35 * coccinelle/README: Documentation stub.
32 * coccinelle/vector_contents.cocci: Semantic patch to replace direct 36 * coccinelle/vector_contents.cocci: Semantic patch to replace direct
33 access to `contents' member of Lisp_Vector objects with AREF and ASET 37 access to `contents' member of Lisp_Vector objects with AREF and ASET
34 where appropriate. 38 where appropriate.
35 39
362012-06-22 Paul Eggert <eggert@cs.ucla.edu> 402012-06-22 Paul Eggert <eggert@cs.ucla.edu>
37 41
@@ -50,9 +54,9 @@
50 54
512012-06-13 Andreas Schwab <schwab@linux-m68k.org> 552012-06-13 Andreas Schwab <schwab@linux-m68k.org>
52 56
53 * make-emacs: Rename --union-type to --check-lisp-type. Define 57 * make-emacs: Rename --union-type to --check-lisp-type.
54 CHECK_LISP_OBJECT_TYPE insted of USE_LISP_UNION_TYPE. 58 Define CHECK_LISP_OBJECT_TYPE insted of USE_LISP_UNION_TYPE.
55 * CPP-DEFINES (DEBUG_LISP_OBJECT_TYPE): Renamed from 59 * CPP-DEFINES (DEBUG_LISP_OBJECT_TYPE): Rename from
56 USE_LISP_UNION_TYPE. 60 USE_LISP_UNION_TYPE.
57 61
582012-06-03 Glenn Morris <rgm@gnu.org> 622012-06-03 Glenn Morris <rgm@gnu.org>
@@ -223,11 +227,11 @@
223 227
224 * unidata/makefile.w32-in (all): Remove src/biditype.h and 228 * unidata/makefile.w32-in (all): Remove src/biditype.h and
225 src/bidimirror.h. 229 src/bidimirror.h.
226 (../../src/biditype.h, ../../src/bidimirror.h): Deleted. 230 (../../src/biditype.h, ../../src/bidimirror.h): Delete.
227 231
228 * unidata/Makefile.in (all): Remove src/biditype.h and 232 * unidata/Makefile.in (all): Remove src/biditype.h and
229 src/bidimirror.h. 233 src/bidimirror.h.
230 (../../src/biditype.h, ../../src/bidimirror.h): Deleted. 234 (../../src/biditype.h, ../../src/bidimirror.h): Delete.
231 235
2322011-07-07 Juanma Barranquero <lekktu@gmail.com> 2362011-07-07 Juanma Barranquero <lekktu@gmail.com>
233 237
@@ -238,8 +242,8 @@
238 242
239 * unidata/unidata-gen.el (unidata-dir): New variable. 243 * unidata/unidata-gen.el (unidata-dir): New variable.
240 (unidata-setup-list): Expand unidata-text-file in unidata-dir. 244 (unidata-setup-list): Expand unidata-text-file in unidata-dir.
241 (unidata-prop-alist): INDEX element may be a function. New 245 (unidata-prop-alist): INDEX element may be a function.
242 optional element VAL-LIST (for general-category and bidi-class). 246 New optional element VAL-LIST (for general-category and bidi-class).
243 New entry `mirroring'. 247 New entry `mirroring'.
244 (unidata-prop-default, unidata-prop-val-list): New subst. 248 (unidata-prop-default, unidata-prop-val-list): New subst.
245 (unidata-get-character, unidata-put-character): Delete them. 249 (unidata-get-character, unidata-put-character): Delete them.
@@ -595,13 +599,13 @@
595 599
5962009-04-17 Kenichi Handa <handa@m17n.org> 6002009-04-17 Kenichi Handa <handa@m17n.org>
597 601
598 * unidata/unidata-gen.el (unidata-get-decomposition): Adjust 602 * unidata/unidata-gen.el (unidata-get-decomposition):
599 Hangle decomposition rule to Unicode. 603 Adjust Hangle decomposition rule to Unicode.
600 604
6012009-04-09 Kenichi Handa <handa@m17n.org> 6052009-04-09 Kenichi Handa <handa@m17n.org>
602 606
603 * unidata/unidata-gen.el (unidata-describe-decomposition): Return 607 * unidata/unidata-gen.el (unidata-describe-decomposition):
604 a string with a composition property to disable combining 608 Return a string with a composition property to disable combining
605 characters being composed. 609 characters being composed.
606 610
6072009-03-11 Miles Bader <miles@gnu.org> 6112009-03-11 Miles Bader <miles@gnu.org>
@@ -1096,7 +1100,7 @@
1096 1100
10972005-10-17 Bill Wohler <wohler@newt.com> 11012005-10-17 Bill Wohler <wohler@newt.com>
1098 1102
1099 * FOR-RELEASE (DOCUMENTATION): Removed lisp/toolbar from list 1103 * FOR-RELEASE (DOCUMENTATION): Remove lisp/toolbar from list
1100 since it's gone. Also marked mh-e as done. 1104 since it's gone. Also marked mh-e as done.
1101 1105
11022005-10-11 Juanma Barranquero <lekktu@gmail.com> 11062005-10-11 Juanma Barranquero <lekktu@gmail.com>
@@ -1143,7 +1147,7 @@
1143 1147
11442005-03-30 Marcelo Toledo <marcelo@marcelotoledo.org> 11482005-03-30 Marcelo Toledo <marcelo@marcelotoledo.org>
1145 1149
1146 * FOR-RELEASE (Documentation): Added check the Emacs Tutorial. 1150 * FOR-RELEASE (Documentation): Add check the Emacs Tutorial.
1147 The first line of every tutorial must begin with a sentence saying 1151 The first line of every tutorial must begin with a sentence saying
1148 "Emacs Tutorial" in the respective language. This should be 1152 "Emacs Tutorial" in the respective language. This should be
1149 followed by "See end for copying conditions", likewise in the 1153 followed by "See end for copying conditions", likewise in the
diff --git a/admin/bzrmerge.el b/admin/bzrmerge.el
index 15238f44d9d..4f5cee14737 100644
--- a/admin/bzrmerge.el
+++ b/admin/bzrmerge.el
@@ -24,8 +24,7 @@
24 24
25;;; Code: 25;;; Code:
26 26
27(eval-when-compile 27(eval-when-compile (require 'cl-lib))
28 (require 'cl)) ; assert
29 28
30(defvar bzrmerge-skip-regexp 29(defvar bzrmerge-skip-regexp
31 "back[- ]?port\\|merge\\|sync\\|re-?generate\\|bump version\\|from trunk\\|\ 30 "back[- ]?port\\|merge\\|sync\\|re-?generate\\|bump version\\|from trunk\\|\
@@ -256,17 +255,17 @@ Does not make other difference."
256 ;; Do a "skip" (i.e. merge the meta-data only). 255 ;; Do a "skip" (i.e. merge the meta-data only).
257 (setq beg (1- (car skip))) 256 (setq beg (1- (car skip)))
258 (while (and skip (or (null merge) (< (car skip) (car merge)))) 257 (while (and skip (or (null merge) (< (car skip) (car merge))))
259 (assert (> (car skip) (or end beg))) 258 (cl-assert (> (car skip) (or end beg)))
260 (setq end (pop skip))) 259 (setq end (pop skip)))
261 (message "Skipping %s..%s" beg end) 260 (message "Skipping %s..%s" beg end)
262 (bzrmerge-add-metadata from end)) 261 (bzrmerge-add-metadata from end))
263 262
264 (t 263 (t
265 ;; Do a "normal" merge. 264 ;; Do a "normal" merge.
266 (assert (or (null skip) (< (car merge) (car skip)))) 265 (cl-assert (or (null skip) (< (car merge) (car skip))))
267 (setq beg (1- (car merge))) 266 (setq beg (1- (car merge)))
268 (while (and merge (or (null skip) (< (car merge) (car skip)))) 267 (while (and merge (or (null skip) (< (car merge) (car skip))))
269 (assert (> (car merge) (or end beg))) 268 (cl-assert (> (car merge) (or end beg)))
270 (setq end (pop merge))) 269 (setq end (pop merge)))
271 (message "Merging %s..%s" beg end) 270 (message "Merging %s..%s" beg end)
272 (if (with-temp-buffer 271 (if (with-temp-buffer
diff --git a/leim/ChangeLog b/leim/ChangeLog
index 34523227f83..f3acaebec94 100644
--- a/leim/ChangeLog
+++ b/leim/ChangeLog
@@ -1,3 +1,9 @@
12012-07-10 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * quail/ipa.el: Use cl-lib.
4
5 * quail/hangul.el: Don't require CL.
6
12012-06-12 Nguyen Thai Ngoc Duy <pclouds@gmail.com> 72012-06-12 Nguyen Thai Ngoc Duy <pclouds@gmail.com>
2 8
3 * quail/vnvi.el: New file (Bug#4747). 9 * quail/vnvi.el: New file (Bug#4747).
diff --git a/leim/quail/hangul.el b/leim/quail/hangul.el
index 2ce55a57107..d30957ae7e6 100644
--- a/leim/quail/hangul.el
+++ b/leim/quail/hangul.el
@@ -30,7 +30,6 @@
30;;; Code: 30;;; Code:
31 31
32(require 'quail) 32(require 'quail)
33(eval-when-compile (require 'cl)) ; for setf
34(require 'hanja-util) 33(require 'hanja-util)
35 34
36;; Hangul double Jamo table. 35;; Hangul double Jamo table.
diff --git a/leim/quail/ipa.el b/leim/quail/ipa.el
index 72db819fa23..b29a6ffc113 100644
--- a/leim/quail/ipa.el
+++ b/leim/quail/ipa.el
@@ -29,7 +29,7 @@
29;;; Code: 29;;; Code:
30 30
31(require 'quail) 31(require 'quail)
32(eval-when-compile (require 'cl)) 32(eval-when-compile (require 'cl-lib))
33 33
34(quail-define-package 34(quail-define-package
35 "ipa" "IPA" "IPA" t 35 "ipa" "IPA" "IPA" t
@@ -277,13 +277,13 @@ string."
277 (setq quail-keymap (list (string quail-keymap))) 277 (setq quail-keymap (list (string quail-keymap)))
278 (if (stringp quail-keymap) 278 (if (stringp quail-keymap)
279 (setq quail-keymap (list quail-keymap)) 279 (setq quail-keymap (list quail-keymap))
280 (assert (vectorp quail-keymap) t) 280 (cl-assert (vectorp quail-keymap) t)
281 (setq quail-keymap (append quail-keymap nil)))) 281 (setq quail-keymap (append quail-keymap nil))))
282 (list 282 (list
283 (apply 'vector 283 (apply 'vector
284 (mapcar 284 (mapcar
285 #'(lambda (entry) 285 #'(lambda (entry)
286 (assert (char-or-string-p entry) t) 286 (cl-assert (char-or-string-p entry) t)
287 (format "%s%s" to-prepend 287 (format "%s%s" to-prepend
288 (if (integerp entry) (string entry) entry))) 288 (if (integerp entry) (string entry) entry)))
289 quail-keymap)))) 289 quail-keymap))))
@@ -318,18 +318,18 @@ particular sequence of keys, and the result will be cached by Quail."
318 (dolist (underscoring underscore-map) 318 (dolist (underscoring underscore-map)
319 (cond ((null underscoring)) 319 (cond ((null underscoring))
320 ((eq (length underscoring) 2) 320 ((eq (length underscoring) 2)
321 (setq underscore-map-entry (second underscoring)) 321 (setq underscore-map-entry (cl-second underscoring))
322 (setcdr underscoring (ipa-x-sampa-prepend-to-keymap-entry 322 (setcdr underscoring (ipa-x-sampa-prepend-to-keymap-entry
323 pre-underscore-map underscore-map-entry))) 323 pre-underscore-map underscore-map-entry)))
324 ((eq (length underscoring) 3) 324 ((eq (length underscoring) 3)
325 (setq underscore-map-entry (second (third underscoring))) 325 (setq underscore-map-entry (cl-second (cl-third underscoring)))
326 (setcdr (third underscoring) 326 (setcdr (cl-third underscoring)
327 (ipa-x-sampa-prepend-to-keymap-entry 327 (ipa-x-sampa-prepend-to-keymap-entry
328 pre-underscore-map underscore-map-entry))) 328 pre-underscore-map underscore-map-entry)))
329 (t 329 (t
330 (assert (null t) t 330 (cl-assert (null t) t
331 "Can't handle subtrees of this level right now.")))) 331 "Can't handle subtrees of this level right now."))))
332 (append underscore-map (list (list ?< (second x-sampa-submap-entry)))))) 332 (append underscore-map (list (list ?< (cl-second x-sampa-submap-entry))))))
333 333
334(quail-define-package 334(quail-define-package
335 "ipa-x-sampa" "IPA" "IPA-X" t 335 "ipa-x-sampa" "IPA" "IPA-X" t
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index a441bd0456f..a82048617cf 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,25 @@
12012-07-10 Stefan Monnier <monnier@iro.umontreal.ca> 12012-07-10 Stefan Monnier <monnier@iro.umontreal.ca>
2 2
3 Reduce use of (require 'cl).
4 * vc/smerge-mode.el, vc/pcvs.el, vc/pcvs-util.el, vc/pcvs-info.el:
5 * vc/diff-mode.el, vc/cvs-status.el, uniquify.el, scroll-bar.el:
6 * register.el, progmodes/sh-script.el, net/gnutls.el, net/dbus.el:
7 * msb.el, mpc.el, minibuffer.el, international/ucs-normalize.el:
8 * international/quail.el, info-xref.el, imenu.el, image-mode.el:
9 * font-lock.el, filesets.el, edmacro.el, doc-view.el, bookmark.el:
10 * battery.el, avoid.el, abbrev.el: Use cl-lib.
11 * vc/pcvs-parse.el, vc/pcvs-defs.el, vc/log-view.el, vc/log-edit.el:
12 * vc/diff.el, simple.el, pcomplete.el, lpr.el, comint.el, loadhist.el:
13 * jit-lock.el, international/iso-ascii.el, info.el, frame.el, bs.el:
14 * emulation/crisp.el, electric.el, dired.el, cus-dep.el, composite.el:
15 * calculator.el, autorevert.el, apropos.el: Don't require CL.
16 * emacs-lisp/bytecomp.el (byte-recompile-directory, display-call-tree)
17 (byte-compile-unfold-bcf, byte-compile-check-variable):
18 * emacs-lisp/byte-opt.el (byte-compile-trueconstp)
19 (byte-compile-nilconstp):
20 * emacs-lisp/autoload.el (make-autoload): Use pcase.
21 * face-remap.el (text-scale-adjust): Simplify pcase patterns.
22
3 * emacs-lisp/gv.el (cond): Make it a valid place. 23 * emacs-lisp/gv.el (cond): Make it a valid place.
4 (if): Simplify slightly. 24 (if): Simplify slightly.
5 25
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index 9b82b3bc893..114afd8c813 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -31,7 +31,7 @@
31 31
32;;; Code: 32;;; Code:
33 33
34(eval-when-compile (require 'cl)) 34(eval-when-compile (require 'cl-lib))
35 35
36(defgroup abbrev-mode nil 36(defgroup abbrev-mode nil
37 "Word abbreviations mode." 37 "Word abbreviations mode."
@@ -540,7 +540,7 @@ the current abbrev table before abbrev lookup happens."
540 (dotimes (i (length table)) 540 (dotimes (i (length table))
541 (aset table i 0)) 541 (aset table i 0))
542 ;; Preserve the table's properties. 542 ;; Preserve the table's properties.
543 (assert sym) 543 (cl-assert sym)
544 (let ((newsym (intern "" table))) 544 (let ((newsym (intern "" table)))
545 (set newsym nil) ; Make sure it won't be confused for an abbrev. 545 (set newsym nil) ; Make sure it won't be confused for an abbrev.
546 (setplist newsym (symbol-plist sym))) 546 (setplist newsym (symbol-plist sym)))
@@ -583,8 +583,8 @@ An obsolete but still supported calling form is:
583\(define-abbrev TABLE NAME EXPANSION &optional HOOK COUNT SYSTEM)." 583\(define-abbrev TABLE NAME EXPANSION &optional HOOK COUNT SYSTEM)."
584 (when (and (consp props) (or (null (car props)) (numberp (car props)))) 584 (when (and (consp props) (or (null (car props)) (numberp (car props))))
585 ;; Old-style calling convention. 585 ;; Old-style calling convention.
586 (setq props (list* :count (car props) 586 (setq props `(:count ,(car props)
587 (if (cadr props) (list :system (cadr props)))))) 587 ,@(if (cadr props) (list :system (cadr props))))))
588 (unless (plist-get props :count) 588 (unless (plist-get props :count)
589 (setq props (plist-put props :count 0))) 589 (setq props (plist-put props :count 0)))
590 (let ((system-flag (plist-get props :system)) 590 (let ((system-flag (plist-get props :system))
@@ -621,7 +621,7 @@ current (if global is nil) or standard syntax table."
621 (let ((badchars ()) 621 (let ((badchars ())
622 (pos 0)) 622 (pos 0))
623 (while (string-match "\\W" abbrev pos) 623 (while (string-match "\\W" abbrev pos)
624 (pushnew (aref abbrev (match-beginning 0)) badchars) 624 (cl-pushnew (aref abbrev (match-beginning 0)) badchars)
625 (setq pos (1+ pos))) 625 (setq pos (1+ pos)))
626 (error "Some abbrev characters (%s) are not word constituents %s" 626 (error "Some abbrev characters (%s) are not word constituents %s"
627 (apply 'string (nreverse badchars)) 627 (apply 'string (nreverse badchars))
@@ -836,8 +836,7 @@ return value is that of `abbrev-insert'.)"
836 (interactive) 836 (interactive)
837 (run-hooks 'pre-abbrev-expand-hook) 837 (run-hooks 'pre-abbrev-expand-hook)
838 (with-wrapper-hook abbrev-expand-functions () 838 (with-wrapper-hook abbrev-expand-functions ()
839 (destructuring-bind (&optional sym name wordstart wordend) 839 (pcase-let ((`(,sym ,name ,wordstart ,wordend) (abbrev--before-point)))
840 (abbrev--before-point)
841 (when sym 840 (when sym
842 (let ((startpos (copy-marker (point) t)) 841 (let ((startpos (copy-marker (point) t))
843 (endmark (copy-marker wordend t))) 842 (endmark (copy-marker wordend t)))
diff --git a/lisp/apropos.el b/lisp/apropos.el
index f5373b38682..e1c3e06752d 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -36,12 +36,12 @@
36;; Fixed bug, current-local-map can return nil. 36;; Fixed bug, current-local-map can return nil.
37;; Change, doesn't calculate key-bindings unless needed. 37;; Change, doesn't calculate key-bindings unless needed.
38;; Added super-apropos capability, changed print functions. 38;; Added super-apropos capability, changed print functions.
39;;; Made fast-apropos and super-apropos share code. 39;; Made fast-apropos and super-apropos share code.
40;;; Sped up fast-apropos again. 40;; Sped up fast-apropos again.
41;; Added apropos-do-all option. 41;; Added apropos-do-all option.
42;;; Added fast-command-apropos. 42;; Added fast-command-apropos.
43;; Changed doc strings to comments for helping functions. 43;; Changed doc strings to comments for helping functions.
44;;; Made doc file buffer read-only, buried it. 44;; Made doc file buffer read-only, buried it.
45;; Only call substitute-command-keys if do-all set. 45;; Only call substitute-command-keys if do-all set.
46 46
47;; Optionally use configurable faces to make the output more legible. 47;; Optionally use configurable faces to make the output more legible.
@@ -57,7 +57,6 @@
57;;; Code: 57;;; Code:
58 58
59(require 'button) 59(require 'button)
60(eval-when-compile (require 'cl))
61 60
62(defgroup apropos nil 61(defgroup apropos nil
63 "Apropos commands for users and programmers." 62 "Apropos commands for users and programmers."
@@ -640,11 +639,11 @@ the output includes key-bindings of commands."
640 (setq lh (cdr lh))))) 639 (setq lh (cdr lh)))))
641 (unless lh-entry (error "Unknown library `%s'" file))) 640 (unless lh-entry (error "Unknown library `%s'" file)))
642 (dolist (x (cdr lh-entry)) 641 (dolist (x (cdr lh-entry))
643 (case (car-safe x) 642 (pcase (car-safe x)
644 ;; (autoload (push (cdr x) autoloads)) 643 ;; (autoload (push (cdr x) autoloads))
645 (require (push (cdr x) requires)) 644 (`require (push (cdr x) requires))
646 (provide (push (cdr x) provides)) 645 (`provide (push (cdr x) provides))
647 (t (push (or (cdr-safe x) x) symbols)))) 646 (_ (push (or (cdr-safe x) x) symbols))))
648 (let ((apropos-pattern "")) ;Dummy binding for apropos-symbols-internal. 647 (let ((apropos-pattern "")) ;Dummy binding for apropos-symbols-internal.
649 (apropos-symbols-internal 648 (apropos-symbols-internal
650 symbols apropos-do-all 649 symbols apropos-do-all
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index 11005f49f44..0f082d2ee9c 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -94,9 +94,6 @@
94 94
95(require 'timer) 95(require 'timer)
96 96
97(eval-when-compile (require 'cl))
98
99
100;; Custom Group: 97;; Custom Group:
101;; 98;;
102;; The two modes will be placed next to Auto Save Mode under the 99;; The two modes will be placed next to Auto Save Mode under the
diff --git a/lisp/avoid.el b/lisp/avoid.el
index bfe15de0ca2..2fa6ef39e70 100644
--- a/lisp/avoid.el
+++ b/lisp/avoid.el
@@ -67,7 +67,7 @@
67 67
68;;; Code: 68;;; Code:
69 69
70(eval-when-compile (require 'cl)) 70(eval-when-compile (require 'cl-lib))
71 71
72(defgroup avoid nil 72(defgroup avoid nil
73 "Make mouse pointer stay out of the way of editing." 73 "Make mouse pointer stay out of the way of editing."
@@ -206,30 +206,30 @@ If you want the mouse banished to a different corner set
206 (let* ((fra-or-win (assoc-default 206 (let* ((fra-or-win (assoc-default
207 'frame-or-window 207 'frame-or-window
208 mouse-avoidance-banish-position 'eq)) 208 mouse-avoidance-banish-position 'eq))
209 (list-values (case fra-or-win 209 (list-values (pcase fra-or-win
210 (frame (list 0 0 (frame-width) (frame-height))) 210 (`frame (list 0 0 (frame-width) (frame-height)))
211 (window (window-edges)))) 211 (`window (window-edges))))
212 (alist (loop for v in list-values 212 (alist (cl-loop for v in list-values
213 for k in '(left top right bottom) 213 for k in '(left top right bottom)
214 collect (cons k v))) 214 collect (cons k v)))
215 (side (assoc-default 215 (side (assoc-default
216 'side 216 'side
217 mouse-avoidance-banish-position 'eq)) 217 mouse-avoidance-banish-position #'eq))
218 (side-dist (assoc-default 218 (side-dist (assoc-default
219 'side-pos 219 'side-pos
220 mouse-avoidance-banish-position 'eq)) 220 mouse-avoidance-banish-position #'eq))
221 (top-or-bottom (assoc-default 221 (top-or-bottom (assoc-default
222 'top-or-bottom 222 'top-or-bottom
223 mouse-avoidance-banish-position 'eq)) 223 mouse-avoidance-banish-position #'eq))
224 (top-or-bottom-dist (assoc-default 224 (top-or-bottom-dist (assoc-default
225 'top-or-bottom-pos 225 'top-or-bottom-pos
226 mouse-avoidance-banish-position 'eq)) 226 mouse-avoidance-banish-position #'eq))
227 (side-fn (case side 227 (side-fn (pcase side
228 (left '+) 228 (`left '+)
229 (right '-))) 229 (`right '-)))
230 (top-or-bottom-fn (case top-or-bottom 230 (top-or-bottom-fn (pcase top-or-bottom
231 (top '+) 231 (`top '+)
232 (bottom '-)))) 232 (`bottom '-))))
233 (cons (funcall side-fn ; -/+ 233 (cons (funcall side-fn ; -/+
234 (assoc-default side alist 'eq) ; right or left 234 (assoc-default side alist 'eq) ; right or left
235 side-dist) ; distance from side 235 side-dist) ; distance from side
diff --git a/lisp/battery.el b/lisp/battery.el
index dcfe07121b3..8e98291b11c 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -31,8 +31,7 @@
31;;; Code: 31;;; Code:
32 32
33(require 'timer) 33(require 'timer)
34(eval-when-compile (require 'cl)) 34(eval-when-compile (require 'cl-lib))
35
36 35
37(defgroup battery nil 36(defgroup battery nil
38 "Display battery status information." 37 "Display battery status information."
@@ -360,16 +359,16 @@ The following %-sequences are provided:
360 (when (re-search-forward "present: +yes$" nil t) 359 (when (re-search-forward "present: +yes$" nil t)
361 (when (re-search-forward "design capacity: +\\([0-9]+\\) m[AW]h$" 360 (when (re-search-forward "design capacity: +\\([0-9]+\\) m[AW]h$"
362 nil t) 361 nil t)
363 (incf design-capacity (string-to-number (match-string 1)))) 362 (cl-incf design-capacity (string-to-number (match-string 1))))
364 (when (re-search-forward "last full capacity: +\\([0-9]+\\) m[AW]h$" 363 (when (re-search-forward "last full capacity: +\\([0-9]+\\) m[AW]h$"
365 nil t) 364 nil t)
366 (incf last-full-capacity (string-to-number (match-string 1)))) 365 (cl-incf last-full-capacity (string-to-number (match-string 1))))
367 (when (re-search-forward 366 (when (re-search-forward
368 "design capacity warning: +\\([0-9]+\\) m[AW]h$" nil t) 367 "design capacity warning: +\\([0-9]+\\) m[AW]h$" nil t)
369 (incf warn (string-to-number (match-string 1)))) 368 (cl-incf warn (string-to-number (match-string 1))))
370 (when (re-search-forward "design capacity low: +\\([0-9]+\\) m[AW]h$" 369 (when (re-search-forward "design capacity low: +\\([0-9]+\\) m[AW]h$"
371 nil t) 370 nil t)
372 (incf low (string-to-number (match-string 1))))))) 371 (cl-incf low (string-to-number (match-string 1)))))))
373 (setq full-capacity (if (> last-full-capacity 0) 372 (setq full-capacity (if (> last-full-capacity 0)
374 last-full-capacity design-capacity)) 373 last-full-capacity design-capacity))
375 (and capacity rate 374 (and capacity rate
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index bf2ea9a9517..8e6fb94c0dd 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -33,7 +33,7 @@
33;;; Code: 33;;; Code:
34 34
35(require 'pp) 35(require 'pp)
36(eval-when-compile (require 'cl)) 36(eval-when-compile (require 'cl-lib))
37 37
38;;; Misc comments: 38;;; Misc comments:
39;; 39;;
@@ -2015,11 +2015,11 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\
2015 (tmp-list ())) 2015 (tmp-list ()))
2016 (while 2016 (while
2017 (let ((char (read-key (concat prompt bookmark-search-pattern)))) 2017 (let ((char (read-key (concat prompt bookmark-search-pattern))))
2018 (case char 2018 (pcase char
2019 ((?\e ?\r) nil) ; RET or ESC break the search loop. 2019 ((or ?\e ?\r) nil) ; RET or ESC break the search loop.
2020 (?\C-g (setq bookmark-quit-flag t) nil) 2020 (?\C-g (setq bookmark-quit-flag t) nil)
2021 (?\d (pop tmp-list) t) ; Delete last char of pattern with DEL 2021 (?\d (pop tmp-list) t) ; Delete last char of pattern with DEL
2022 (t 2022 (_
2023 (if (characterp char) 2023 (if (characterp char)
2024 (push char tmp-list) 2024 (push char tmp-list)
2025 (setq unread-command-events 2025 (setq unread-command-events
@@ -2034,9 +2034,9 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\
2034(defun bookmark-bmenu-filter-alist-by-regexp (regexp) 2034(defun bookmark-bmenu-filter-alist-by-regexp (regexp)
2035 "Filter `bookmark-alist' with bookmarks matching REGEXP and rebuild list." 2035 "Filter `bookmark-alist' with bookmarks matching REGEXP and rebuild list."
2036 (let ((bookmark-alist 2036 (let ((bookmark-alist
2037 (loop for i in bookmark-alist 2037 (cl-loop for i in bookmark-alist
2038 when (string-match regexp (car i)) collect i into new 2038 when (string-match regexp (car i)) collect i into new
2039 finally return new))) 2039 finally return new)))
2040 (bookmark-bmenu-list))) 2040 (bookmark-bmenu-list)))
2041 2041
2042 2042
diff --git a/lisp/bs.el b/lisp/bs.el
index 08d05a946e3..09aefee416e 100644
--- a/lisp/bs.el
+++ b/lisp/bs.el
@@ -124,8 +124,6 @@
124 124
125;;; Code: 125;;; Code:
126 126
127(eval-when-compile (require 'cl))
128
129;; ---------------------------------------------------------------------- 127;; ----------------------------------------------------------------------
130;; Globals for customization 128;; Globals for customization
131;; ---------------------------------------------------------------------- 129;; ----------------------------------------------------------------------
@@ -830,10 +828,10 @@ See `visit-tags-table'."
830 (interactive) 828 (interactive)
831 (let ((res 829 (let ((res
832 (with-current-buffer (bs--current-buffer) 830 (with-current-buffer (bs--current-buffer)
833 (setq bs-buffer-show-mark (case bs-buffer-show-mark 831 (setq bs-buffer-show-mark (pcase bs-buffer-show-mark
834 ((nil) 'never) 832 (`nil 'never)
835 ((never) 'always) 833 (`never 'always)
836 (t nil)))))) 834 (_ nil))))))
837 (bs--update-current-line) 835 (bs--update-current-line)
838 (bs--set-window-height) 836 (bs--set-window-height)
839 (bs--show-config-message res))) 837 (bs--show-config-message res)))
diff --git a/lisp/calculator.el b/lisp/calculator.el
index 14f50a0adcb..b1a3f9e0759 100644
--- a/lisp/calculator.el
+++ b/lisp/calculator.el
@@ -43,8 +43,6 @@
43;;; History: 43;;; History:
44;; I hate history. 44;; I hate history.
45 45
46(eval-when-compile (require 'cl))
47
48;;;===================================================================== 46;;;=====================================================================
49;;; Customization: 47;;; Customization:
50 48
diff --git a/lisp/comint.el b/lisp/comint.el
index 4ccbfb5f9c8..431d05b75c2 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -101,7 +101,6 @@
101 101
102;;; Code: 102;;; Code:
103 103
104(eval-when-compile (require 'cl))
105(require 'ring) 104(require 'ring)
106(require 'ansi-color) 105(require 'ansi-color)
107(require 'regexp-opt) ;For regexp-opt-charset. 106(require 'regexp-opt) ;For regexp-opt-charset.
diff --git a/lisp/composite.el b/lisp/composite.el
index 72317ac470e..4832848cb90 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -29,8 +29,6 @@
29 29
30;;; Code: 30;;; Code:
31 31
32(eval-when-compile (require 'cl))
33
34(defconst reference-point-alist 32(defconst reference-point-alist
35 '((tl . 0) (tc . 1) (tr . 2) 33 '((tl . 0) (tc . 1) (tr . 2)
36 (Bl . 3) (Bc . 4) (Br . 5) 34 (Bl . 3) (Bc . 4) (Br . 5)
diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el
index cd946bdc99b..bfe3ae36c7e 100644
--- a/lisp/cus-dep.el
+++ b/lisp/cus-dep.el
@@ -25,7 +25,6 @@
25 25
26;;; Code: 26;;; Code:
27 27
28(eval-when-compile (require 'cl))
29(require 'widget) 28(require 'widget)
30(require 'cus-face) 29(require 'cus-face)
31 30
diff --git a/lisp/dired.el b/lisp/dired.el
index 68e1e574a00..18480acd968 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -34,8 +34,6 @@
34 34
35;;; Code: 35;;; Code:
36 36
37(eval-when-compile (require 'cl))
38
39;;; Customizable variables 37;;; Customizable variables
40 38
41(defgroup dired nil 39(defgroup dired nil
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index f526825b0bd..72b36feb1d8 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -133,7 +133,7 @@
133 133
134;;; Code: 134;;; Code:
135 135
136(eval-when-compile (require 'cl)) 136(eval-when-compile (require 'cl-lib))
137(require 'dired) 137(require 'dired)
138(require 'image-mode) 138(require 'image-mode)
139(require 'jka-compr) 139(require 'jka-compr)
@@ -259,9 +259,9 @@ of the page moves to the previous page."
259 (setq ol nil)) 259 (setq ol nil))
260 (if ol 260 (if ol
261 (progn 261 (progn
262 (assert (eq (overlay-buffer ol) (current-buffer))) 262 (cl-assert (eq (overlay-buffer ol) (current-buffer)))
263 (setq ol (copy-overlay ol))) 263 (setq ol (copy-overlay ol)))
264 (assert (not (get-char-property (point-min) 'display))) 264 (cl-assert (not (get-char-property (point-min) 'display)))
265 (setq ol (make-overlay (point-min) (point-max) nil t)) 265 (setq ol (make-overlay (point-min) (point-max) nil t))
266 (overlay-put ol 'doc-view t)) 266 (overlay-put ol 'doc-view t))
267 (overlay-put ol 'window (car winprops)) 267 (overlay-put ol 'window (car winprops))
@@ -892,30 +892,30 @@ Start by converting PAGES, and then the rest."
892(defun doc-view-doc->txt (txt callback) 892(defun doc-view-doc->txt (txt callback)
893 "Convert the current document to text and call CALLBACK when done." 893 "Convert the current document to text and call CALLBACK when done."
894 (make-directory (doc-view-current-cache-dir) t) 894 (make-directory (doc-view-current-cache-dir) t)
895 (case doc-view-doc-type 895 (pcase doc-view-doc-type
896 (pdf 896 (`pdf
897 ;; Doc is a PDF, so convert it to TXT 897 ;; Doc is a PDF, so convert it to TXT
898 (doc-view-pdf->txt doc-view-buffer-file-name txt callback)) 898 (doc-view-pdf->txt doc-view-buffer-file-name txt callback))
899 (ps 899 (`ps
900 ;; Doc is a PS, so convert it to PDF (which will be converted to 900 ;; Doc is a PS, so convert it to PDF (which will be converted to
901 ;; TXT thereafter). 901 ;; TXT thereafter).
902 (let ((pdf (expand-file-name "doc.pdf" 902 (let ((pdf (expand-file-name "doc.pdf"
903 (doc-view-current-cache-dir)))) 903 (doc-view-current-cache-dir))))
904 (doc-view-ps->pdf doc-view-buffer-file-name pdf 904 (doc-view-ps->pdf doc-view-buffer-file-name pdf
905 (lambda () (doc-view-pdf->txt pdf txt callback))))) 905 (lambda () (doc-view-pdf->txt pdf txt callback)))))
906 (dvi 906 (`dvi
907 ;; Doc is a DVI. This means that a doc.pdf already exists in its 907 ;; Doc is a DVI. This means that a doc.pdf already exists in its
908 ;; cache subdirectory. 908 ;; cache subdirectory.
909 (doc-view-pdf->txt (expand-file-name "doc.pdf" 909 (doc-view-pdf->txt (expand-file-name "doc.pdf"
910 (doc-view-current-cache-dir)) 910 (doc-view-current-cache-dir))
911 txt callback)) 911 txt callback))
912 (odf 912 (`odf
913 ;; Doc is some ODF (or MS Office) doc. This means that a doc.pdf 913 ;; Doc is some ODF (or MS Office) doc. This means that a doc.pdf
914 ;; already exists in its cache subdirectory. 914 ;; already exists in its cache subdirectory.
915 (doc-view-pdf->txt (expand-file-name "doc.pdf" 915 (doc-view-pdf->txt (expand-file-name "doc.pdf"
916 (doc-view-current-cache-dir)) 916 (doc-view-current-cache-dir))
917 txt callback)) 917 txt callback))
918 (t (error "DocView doesn't know what to do")))) 918 (_ (error "DocView doesn't know what to do"))))
919 919
920(defun doc-view-ps->pdf (ps pdf callback) 920(defun doc-view-ps->pdf (ps pdf callback)
921 "Convert PS to PDF asynchronously and call CALLBACK when finished." 921 "Convert PS to PDF asynchronously and call CALLBACK when finished."
@@ -950,14 +950,14 @@ Those files are saved in the directory given by the function
950 (let ((png-file (expand-file-name "page-%d.png" 950 (let ((png-file (expand-file-name "page-%d.png"
951 (doc-view-current-cache-dir)))) 951 (doc-view-current-cache-dir))))
952 (make-directory (doc-view-current-cache-dir) t) 952 (make-directory (doc-view-current-cache-dir) t)
953 (case doc-view-doc-type 953 (pcase doc-view-doc-type
954 (dvi 954 (`dvi
955 ;; DVI files have to be converted to PDF before Ghostscript can process 955 ;; DVI files have to be converted to PDF before Ghostscript can process
956 ;; it. 956 ;; it.
957 (let ((pdf (expand-file-name "doc.pdf" doc-view-current-cache-dir))) 957 (let ((pdf (expand-file-name "doc.pdf" doc-view-current-cache-dir)))
958 (doc-view-dvi->pdf doc-view-buffer-file-name pdf 958 (doc-view-dvi->pdf doc-view-buffer-file-name pdf
959 (lambda () (doc-view-pdf/ps->png pdf png-file))))) 959 (lambda () (doc-view-pdf/ps->png pdf png-file)))))
960 (odf 960 (`odf
961 ;; ODF files have to be converted to PDF before Ghostscript can 961 ;; ODF files have to be converted to PDF before Ghostscript can
962 ;; process it. 962 ;; process it.
963 (let ((pdf (expand-file-name "doc.pdf" doc-view-current-cache-dir)) 963 (let ((pdf (expand-file-name "doc.pdf" doc-view-current-cache-dir))
@@ -973,11 +973,11 @@ Those files are saved in the directory given by the function
973 ;; Rename to doc.pdf 973 ;; Rename to doc.pdf
974 (rename-file opdf pdf) 974 (rename-file opdf pdf)
975 (doc-view-pdf/ps->png pdf png-file))))) 975 (doc-view-pdf/ps->png pdf png-file)))))
976 (pdf 976 (`pdf
977 (let ((pages (doc-view-active-pages))) 977 (let ((pages (doc-view-active-pages)))
978 ;; Convert PDF to PNG images starting with the active pages. 978 ;; Convert PDF to PNG images starting with the active pages.
979 (doc-view-pdf->png doc-view-buffer-file-name png-file pages))) 979 (doc-view-pdf->png doc-view-buffer-file-name png-file pages)))
980 (t 980 (_
981 ;; Convert to PNG images. 981 ;; Convert to PNG images.
982 (doc-view-pdf/ps->png doc-view-buffer-file-name png-file))))) 982 (doc-view-pdf/ps->png doc-view-buffer-file-name png-file)))))
983 983
@@ -1103,7 +1103,7 @@ have the page we want to view."
1103 (and (not (member pagefile prev-pages)) 1103 (and (not (member pagefile prev-pages))
1104 (member pagefile doc-view-current-files))) 1104 (member pagefile doc-view-current-files)))
1105 (with-selected-window win 1105 (with-selected-window win
1106 (assert (eq (current-buffer) buffer)) 1106 (cl-assert (eq (current-buffer) buffer))
1107 (doc-view-goto-page page)))))))) 1107 (doc-view-goto-page page))))))))
1108 1108
1109(defun doc-view-buffer-message () 1109(defun doc-view-buffer-message ()
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 4bc7f6af69a..b1a24bc88a6 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -63,8 +63,7 @@
63 63
64;;; Code: 64;;; Code:
65 65
66(eval-when-compile 66(eval-when-compile (require 'cl-lib))
67 (require 'cl))
68 67
69(require 'kmacro) 68(require 'kmacro)
70 69
@@ -319,17 +318,18 @@ or nil, use a compact 80-column format."
319 mac)))) 318 mac))))
320 (if no-keys 319 (if no-keys
321 (when cmd 320 (when cmd
322 (loop for key in (where-is-internal cmd '(keymap)) do 321 (cl-loop for key in (where-is-internal cmd '(keymap)) do
323 (global-unset-key key))) 322 (global-unset-key key)))
324 (when keys 323 (when keys
325 (if (= (length mac) 0) 324 (if (= (length mac) 0)
326 (loop for key in keys do (global-unset-key key)) 325 (cl-loop for key in keys do (global-unset-key key))
327 (loop for key in keys do 326 (cl-loop for key in keys do
328 (global-set-key key 327 (global-set-key key
329 (or cmd 328 (or cmd
330 (if (and mac-counter mac-format) 329 (if (and mac-counter mac-format)
331 (kmacro-lambda-form mac mac-counter mac-format) 330 (kmacro-lambda-form
332 mac)))))))))) 331 mac mac-counter mac-format)
332 mac))))))))))
333 (kill-buffer buf) 333 (kill-buffer buf)
334 (when (buffer-name obuf) 334 (when (buffer-name obuf)
335 (switch-to-buffer obuf)) 335 (switch-to-buffer obuf))
@@ -437,9 +437,9 @@ doubt, use whitespace."
437 (one-line (eq verbose 1))) 437 (one-line (eq verbose 1)))
438 (if one-line (setq verbose nil)) 438 (if one-line (setq verbose nil))
439 (when (stringp macro) 439 (when (stringp macro)
440 (loop for i below (length macro) do 440 (cl-loop for i below (length macro) do
441 (when (>= (aref rest-mac i) 128) 441 (when (>= (aref rest-mac i) 128)
442 (incf (aref rest-mac i) (- ?\M-\^@ 128))))) 442 (cl-incf (aref rest-mac i) (- ?\M-\^@ 128)))))
443 (while (not (eq (aref rest-mac 0) 'end-macro)) 443 (while (not (eq (aref rest-mac 0) 'end-macro))
444 (let* ((prefix 444 (let* ((prefix
445 (or (and (integerp (aref rest-mac 0)) 445 (or (and (integerp (aref rest-mac 0))
@@ -448,57 +448,58 @@ doubt, use whitespace."
448 '(digit-argument negative-argument)) 448 '(digit-argument negative-argument))
449 (let ((i 1)) 449 (let ((i 1))
450 (while (memq (aref rest-mac i) (cdr mdigs)) 450 (while (memq (aref rest-mac i) (cdr mdigs))
451 (incf i)) 451 (cl-incf i))
452 (and (not (memq (aref rest-mac i) pkeys)) 452 (and (not (memq (aref rest-mac i) pkeys))
453 (prog1 (vconcat "M-" (edmacro-subseq rest-mac 0 i) " ") 453 (prog1 (vconcat "M-" (edmacro-subseq rest-mac 0 i) " ")
454 (callf edmacro-subseq rest-mac i))))) 454 (cl-callf edmacro-subseq rest-mac i)))))
455 (and (eq (aref rest-mac 0) ?\C-u) 455 (and (eq (aref rest-mac 0) ?\C-u)
456 (eq (key-binding [?\C-u]) 'universal-argument) 456 (eq (key-binding [?\C-u]) 'universal-argument)
457 (let ((i 1)) 457 (let ((i 1))
458 (while (eq (aref rest-mac i) ?\C-u) 458 (while (eq (aref rest-mac i) ?\C-u)
459 (incf i)) 459 (cl-incf i))
460 (and (not (memq (aref rest-mac i) pkeys)) 460 (and (not (memq (aref rest-mac i) pkeys))
461 (prog1 (loop repeat i concat "C-u ") 461 (prog1 (cl-loop repeat i concat "C-u ")
462 (callf edmacro-subseq rest-mac i))))) 462 (cl-callf edmacro-subseq rest-mac i)))))
463 (and (eq (aref rest-mac 0) ?\C-u) 463 (and (eq (aref rest-mac 0) ?\C-u)
464 (eq (key-binding [?\C-u]) 'universal-argument) 464 (eq (key-binding [?\C-u]) 'universal-argument)
465 (let ((i 1)) 465 (let ((i 1))
466 (when (eq (aref rest-mac i) ?-) 466 (when (eq (aref rest-mac i) ?-)
467 (incf i)) 467 (cl-incf i))
468 (while (memq (aref rest-mac i) 468 (while (memq (aref rest-mac i)
469 '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) 469 '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
470 (incf i)) 470 (cl-incf i))
471 (and (not (memq (aref rest-mac i) pkeys)) 471 (and (not (memq (aref rest-mac i) pkeys))
472 (prog1 (vconcat "C-u " (edmacro-subseq rest-mac 1 i) " ") 472 (prog1 (vconcat "C-u " (edmacro-subseq rest-mac 1 i) " ")
473 (callf edmacro-subseq rest-mac i))))))) 473 (cl-callf edmacro-subseq rest-mac i)))))))
474 (bind-len (apply 'max 1 474 (bind-len (apply 'max 1
475 (loop for map in maps 475 (cl-loop for map in maps
476 for b = (lookup-key map rest-mac) 476 for b = (lookup-key map rest-mac)
477 when b collect b))) 477 when b collect b)))
478 (key (edmacro-subseq rest-mac 0 bind-len)) 478 (key (edmacro-subseq rest-mac 0 bind-len))
479 (fkey nil) tlen tkey 479 (fkey nil) tlen tkey
480 (bind (or (loop for map in maps for b = (lookup-key map key) 480 (bind (or (cl-loop for map in maps for b = (lookup-key map key)
481 thereis (and (not (integerp b)) b)) 481 thereis (and (not (integerp b)) b))
482 (and (setq fkey (lookup-key local-function-key-map rest-mac)) 482 (and (setq fkey (lookup-key local-function-key-map rest-mac))
483 (setq tlen fkey tkey (edmacro-subseq rest-mac 0 tlen) 483 (setq tlen fkey tkey (edmacro-subseq rest-mac 0 tlen)
484 fkey (lookup-key local-function-key-map tkey)) 484 fkey (lookup-key local-function-key-map tkey))
485 (loop for map in maps 485 (cl-loop for map in maps
486 for b = (lookup-key map fkey) 486 for b = (lookup-key map fkey)
487 when (and (not (integerp b)) b) 487 when (and (not (integerp b)) b)
488 do (setq bind-len tlen key tkey) 488 do (setq bind-len tlen key tkey)
489 and return b 489 and return b
490 finally do (setq fkey nil))))) 490 finally do (setq fkey nil)))))
491 (first (aref key 0)) 491 (first (aref key 0))
492 (text (loop for i from bind-len below (length rest-mac) 492 (text
493 for ch = (aref rest-mac i) 493 (cl-loop for i from bind-len below (length rest-mac)
494 while (and (integerp ch) 494 for ch = (aref rest-mac i)
495 (> ch 32) (< ch maxkey) (/= ch 92) 495 while (and (integerp ch)
496 (eq (key-binding (char-to-string ch)) 496 (> ch 32) (< ch maxkey) (/= ch 92)
497 'self-insert-command) 497 (eq (key-binding (char-to-string ch))
498 (or (> i (- (length rest-mac) 2)) 498 'self-insert-command)
499 (not (eq ch (aref rest-mac (+ i 1)))) 499 (or (> i (- (length rest-mac) 2))
500 (not (eq ch (aref rest-mac (+ i 2)))))) 500 (not (eq ch (aref rest-mac (+ i 1))))
501 finally return i)) 501 (not (eq ch (aref rest-mac (+ i 2))))))
502 finally return i))
502 desc) 503 desc)
503 (if (stringp bind) (setq bind nil)) 504 (if (stringp bind) (setq bind nil))
504 (cond ((and (eq bind 'self-insert-command) (not prefix) 505 (cond ((and (eq bind 'self-insert-command) (not prefix)
@@ -509,7 +510,7 @@ doubt, use whitespace."
509 (setq desc (concat (edmacro-subseq rest-mac 0 text))) 510 (setq desc (concat (edmacro-subseq rest-mac 0 text)))
510 (when (string-match "^[ACHMsS]-." desc) 511 (when (string-match "^[ACHMsS]-." desc)
511 (setq text 2) 512 (setq text 2)
512 (callf substring desc 0 2)) 513 (cl-callf substring desc 0 2))
513 (not (string-match 514 (not (string-match
514 "^;;\\|^<.*>$\\|^\\\\[0-9]+$\\|^[0-9]+\\*." 515 "^;;\\|^<.*>$\\|^\\\\[0-9]+$\\|^[0-9]+\\*."
515 desc)))) 516 desc))))
@@ -535,17 +536,17 @@ doubt, use whitespace."
535 (cond 536 (cond
536 ((integerp ch) 537 ((integerp ch)
537 (concat 538 (concat
538 (loop for pf across "ACHMsS" 539 (cl-loop for pf across "ACHMsS"
539 for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@ 540 for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@
540 ?\M-\^@ ?\s-\^@ ?\S-\^@) 541 ?\M-\^@ ?\s-\^@ ?\S-\^@)
541 when (/= (logand ch bit) 0) 542 when (/= (logand ch bit) 0)
542 concat (format "%c-" pf)) 543 concat (format "%c-" pf))
543 (let ((ch2 (logand ch (1- (lsh 1 18))))) 544 (let ((ch2 (logand ch (1- (lsh 1 18)))))
544 (cond ((<= ch2 32) 545 (cond ((<= ch2 32)
545 (case ch2 546 (pcase ch2
546 (0 "NUL") (9 "TAB") (10 "LFD") 547 (0 "NUL") (9 "TAB") (10 "LFD")
547 (13 "RET") (27 "ESC") (32 "SPC") 548 (13 "RET") (27 "ESC") (32 "SPC")
548 (t 549 (_
549 (format "C-%c" 550 (format "C-%c"
550 (+ (if (<= ch2 26) 96 64) 551 (+ (if (<= ch2 26) 96 64)
551 ch2))))) 552 ch2)))))
@@ -563,30 +564,30 @@ doubt, use whitespace."
563 (let ((times 1) (pos bind-len)) 564 (let ((times 1) (pos bind-len))
564 (while (not (edmacro-mismatch rest-mac rest-mac 565 (while (not (edmacro-mismatch rest-mac rest-mac
565 0 bind-len pos (+ bind-len pos))) 566 0 bind-len pos (+ bind-len pos)))
566 (incf times) 567 (cl-incf times)
567 (incf pos bind-len)) 568 (cl-incf pos bind-len))
568 (when (> times 1) 569 (when (> times 1)
569 (setq desc (format "%d*%s" times desc)) 570 (setq desc (format "%d*%s" times desc))
570 (setq bind-len (* bind-len times))))) 571 (setq bind-len (* bind-len times)))))
571 (setq rest-mac (edmacro-subseq rest-mac bind-len)) 572 (setq rest-mac (edmacro-subseq rest-mac bind-len))
572 (if verbose 573 (if verbose
573 (progn 574 (progn
574 (unless (equal res "") (callf concat res "\n")) 575 (unless (equal res "") (cl-callf concat res "\n"))
575 (callf concat res desc) 576 (cl-callf concat res desc)
576 (when (and bind (or (stringp bind) (symbolp bind))) 577 (when (and bind (or (stringp bind) (symbolp bind)))
577 (callf concat res 578 (cl-callf concat res
578 (make-string (max (- 3 (/ (length desc) 8)) 1) 9) 579 (make-string (max (- 3 (/ (length desc) 8)) 1) 9)
579 ";; " (if (stringp bind) bind (symbol-name bind)))) 580 ";; " (if (stringp bind) bind (symbol-name bind))))
580 (setq len 0)) 581 (setq len 0))
581 (if (and (> (+ len (length desc) 2) 72) (not one-line)) 582 (if (and (> (+ len (length desc) 2) 72) (not one-line))
582 (progn 583 (progn
583 (callf concat res "\n ") 584 (cl-callf concat res "\n ")
584 (setq len 1)) 585 (setq len 1))
585 (unless (equal res "") 586 (unless (equal res "")
586 (callf concat res " ") 587 (cl-callf concat res " ")
587 (incf len))) 588 (cl-incf len)))
588 (callf concat res desc) 589 (cl-callf concat res desc)
589 (incf len (length desc))))) 590 (cl-incf len (length desc)))))
590 res)) 591 res))
591 592
592(defun edmacro-mismatch (cl-seq1 cl-seq2 cl-start1 cl-end1 cl-start2 cl-end2) 593(defun edmacro-mismatch (cl-seq1 cl-seq2 cl-start1 cl-end1 cl-start2 cl-end2)
@@ -638,9 +639,9 @@ If START or END is negative, it counts from the end."
638The string represents the same events; Meta is indicated by bit 7. 639The string represents the same events; Meta is indicated by bit 7.
639This function assumes that the events can be stored in a string." 640This function assumes that the events can be stored in a string."
640 (setq seq (copy-sequence seq)) 641 (setq seq (copy-sequence seq))
641 (loop for i below (length seq) do 642 (cl-loop for i below (length seq) do
642 (when (logand (aref seq i) 128) 643 (when (logand (aref seq i) 128)
643 (setf (aref seq i) (logand (aref seq i) 127)))) 644 (setf (aref seq i) (logand (aref seq i) 127))))
644 seq) 645 seq)
645 646
646(defun edmacro-fix-menu-commands (macro &optional noerror) 647(defun edmacro-fix-menu-commands (macro &optional noerror)
@@ -655,7 +656,7 @@ This function assumes that the events can be stored in a string."
655 ((eq (car ev) 'switch-frame)) 656 ((eq (car ev) 'switch-frame))
656 ((equal ev '(menu-bar)) 657 ((equal ev '(menu-bar))
657 (push 'menu-bar result)) 658 (push 'menu-bar result))
658 ((equal (cadadr ev) '(menu-bar)) 659 ((equal (cl-cadadr ev) '(menu-bar))
659 (push (vector 'menu-bar (car ev)) result)) 660 (push (vector 'menu-bar (car ev)) result))
660 ;; It would be nice to do pop-up menus, too, but not enough 661 ;; It would be nice to do pop-up menus, too, but not enough
661 ;; info is recorded in macros to make this possible. 662 ;; info is recorded in macros to make this possible.
@@ -715,30 +716,31 @@ This function assumes that the events can be stored in a string."
715 (t 716 (t
716 (let ((orig-word word) (prefix 0) (bits 0)) 717 (let ((orig-word word) (prefix 0) (bits 0))
717 (while (string-match "^[ACHMsS]-." word) 718 (while (string-match "^[ACHMsS]-." word)
718 (incf bits (cdr (assq (aref word 0) 719 (cl-incf bits (cdr (assq (aref word 0)
719 '((?A . ?\A-\^@) (?C . ?\C-\^@) 720 '((?A . ?\A-\^@) (?C . ?\C-\^@)
720 (?H . ?\H-\^@) (?M . ?\M-\^@) 721 (?H . ?\H-\^@) (?M . ?\M-\^@)
721 (?s . ?\s-\^@) (?S . ?\S-\^@))))) 722 (?s . ?\s-\^@) (?S . ?\S-\^@)))))
722 (incf prefix 2) 723 (cl-incf prefix 2)
723 (callf substring word 2)) 724 (cl-callf substring word 2))
724 (when (string-match "^\\^.$" word) 725 (when (string-match "^\\^.$" word)
725 (incf bits ?\C-\^@) 726 (cl-incf bits ?\C-\^@)
726 (incf prefix) 727 (cl-incf prefix)
727 (callf substring word 1)) 728 (cl-callf substring word 1))
728 (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r") 729 (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r")
729 ("LFD" . "\n") ("TAB" . "\t") 730 ("LFD" . "\n") ("TAB" . "\t")
730 ("ESC" . "\e") ("SPC" . " ") 731 ("ESC" . "\e") ("SPC" . " ")
731 ("DEL" . "\177"))))) 732 ("DEL" . "\177")))))
732 (when found (setq word (cdr found)))) 733 (when found (setq word (cdr found))))
733 (when (string-match "^\\\\[0-7]+$" word) 734 (when (string-match "^\\\\[0-7]+$" word)
734 (loop for ch across word 735 (cl-loop for ch across word
735 for n = 0 then (+ (* n 8) ch -48) 736 for n = 0 then (+ (* n 8) ch -48)
736 finally do (setq word (vector n)))) 737 finally do (setq word (vector n))))
737 (cond ((= bits 0) 738 (cond ((= bits 0)
738 (setq key word)) 739 (setq key word))
739 ((and (= bits ?\M-\^@) (stringp word) 740 ((and (= bits ?\M-\^@) (stringp word)
740 (string-match "^-?[0-9]+$" word)) 741 (string-match "^-?[0-9]+$" word))
741 (setq key (loop for x across word collect (+ x bits)))) 742 (setq key (cl-loop for x across word
743 collect (+ x bits))))
742 ((/= (length word) 1) 744 ((/= (length word) 1)
743 (error "%s must prefix a single character, not %s" 745 (error "%s must prefix a single character, not %s"
744 (substring orig-word 0 prefix) word)) 746 (substring orig-word 0 prefix) word))
@@ -752,7 +754,7 @@ This function assumes that the events can be stored in a string."
752 (t 754 (t
753 (setq key (list (+ bits (aref word 0))))))))) 755 (setq key (list (+ bits (aref word 0)))))))))
754 (when key 756 (when key
755 (loop repeat times do (callf vconcat res key))))) 757 (cl-loop repeat times do (cl-callf vconcat res key)))))
756 (when (and (>= (length res) 4) 758 (when (and (>= (length res) 4)
757 (eq (aref res 0) ?\C-x) 759 (eq (aref res 0) ?\C-x)
758 (eq (aref res 1) ?\() 760 (eq (aref res 1) ?\()
@@ -760,13 +762,13 @@ This function assumes that the events can be stored in a string."
760 (eq (aref res (- (length res) 1)) ?\))) 762 (eq (aref res (- (length res) 1)) ?\)))
761 (setq res (edmacro-subseq res 2 -2))) 763 (setq res (edmacro-subseq res 2 -2)))
762 (if (and (not need-vector) 764 (if (and (not need-vector)
763 (loop for ch across res 765 (cl-loop for ch across res
764 always (and (characterp ch) 766 always (and (characterp ch)
765 (let ((ch2 (logand ch (lognot ?\M-\^@)))) 767 (let ((ch2 (logand ch (lognot ?\M-\^@))))
766 (and (>= ch2 0) (<= ch2 127)))))) 768 (and (>= ch2 0) (<= ch2 127))))))
767 (concat (loop for ch across res 769 (concat (cl-loop for ch across res
768 collect (if (= (logand ch ?\M-\^@) 0) 770 collect (if (= (logand ch ?\M-\^@) 0)
769 ch (+ ch 128)))) 771 ch (+ ch 128))))
770 res))) 772 res)))
771 773
772(provide 'edmacro) 774(provide 'edmacro)
diff --git a/lisp/electric.el b/lisp/electric.el
index 6a31ba1f1d3..5f1445577e9 100644
--- a/lisp/electric.el
+++ b/lisp/electric.el
@@ -38,8 +38,6 @@
38 38
39;;; Code: 39;;; Code:
40 40
41(eval-when-compile (require 'cl))
42
43;; This loop is the guts for non-standard modes which retain control 41;; This loop is the guts for non-standard modes which retain control
44;; until some event occurs. It is a `do-forever', the only way out is 42;; until some event occurs. It is a `do-forever', the only way out is
45;; to throw. It assumes that you have set up the keymap, window, and 43;; to throw. It assumes that you have set up the keymap, window, and
@@ -394,16 +392,16 @@ arguments that returns one of those symbols.")
394 (not (nth 8 (save-excursion (syntax-ppss pos))))) 392 (not (nth 8 (save-excursion (syntax-ppss pos)))))
395 (let ((end (copy-marker (point) t))) 393 (let ((end (copy-marker (point) t)))
396 (goto-char pos) 394 (goto-char pos)
397 (case (if (functionp rule) (funcall rule) rule) 395 (pcase (if (functionp rule) (funcall rule) rule)
398 ;; FIXME: we used `newline' down here which called 396 ;; FIXME: we used `newline' down here which called
399 ;; self-insert-command and ran post-self-insert-hook recursively. 397 ;; self-insert-command and ran post-self-insert-hook recursively.
400 ;; It happened to make electric-indent-mode work automatically with 398 ;; It happened to make electric-indent-mode work automatically with
401 ;; electric-layout-mode (at the cost of re-indenting lines 399 ;; electric-layout-mode (at the cost of re-indenting lines
402 ;; multiple times), but I'm not sure it's what we want. 400 ;; multiple times), but I'm not sure it's what we want.
403 (before (goto-char (1- pos)) (skip-chars-backward " \t") 401 (`before (goto-char (1- pos)) (skip-chars-backward " \t")
404 (unless (bolp) (insert "\n"))) 402 (unless (bolp) (insert "\n")))
405 (after (insert "\n")) ; FIXME: check eolp before inserting \n? 403 (`after (insert "\n")) ; FIXME: check eolp before inserting \n?
406 (around (save-excursion 404 (`around (save-excursion
407 (goto-char (1- pos)) (skip-chars-backward " \t") 405 (goto-char (1- pos)) (skip-chars-backward " \t")
408 (unless (bolp) (insert "\n"))) 406 (unless (bolp) (insert "\n")))
409 (insert "\n"))) ; FIXME: check eolp before inserting \n? 407 (insert "\n"))) ; FIXME: check eolp before inserting \n?
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index fba8915fd5f..1bdd6d8fc4b 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -155,13 +155,14 @@ expression, in which case we want to handle forms differently."
155 define-overloadable-function)) 155 define-overloadable-function))
156 (let* ((macrop (memq car '(defmacro defmacro*))) 156 (let* ((macrop (memq car '(defmacro defmacro*)))
157 (name (nth 1 form)) 157 (name (nth 1 form))
158 (args (cl-case car 158 (args (pcase car
159 ((defun defmacro defun* defmacro* 159 ((or `defun `defmacro
160 define-overloadable-function) (nth 2 form)) 160 `defun* `defmacro* `cl-defun `cl-defmacro
161 ((define-skeleton) '(&optional str arg)) 161 `define-overloadable-function) (nth 2 form))
162 ((define-generic-mode define-derived-mode 162 (`define-skeleton '(&optional str arg))
163 define-compilation-mode) nil) 163 ((or `define-generic-mode `define-derived-mode
164 (t))) 164 `define-compilation-mode) nil)
165 (_ t)))
165 (body (nthcdr (or (get car 'doc-string-elt) 3) form)) 166 (body (nthcdr (or (get car 'doc-string-elt) 3) form))
166 (doc (if (stringp (car body)) (pop body)))) 167 (doc (if (stringp (car body)) (pop body))))
167 ;; Add the usage form at the end where describe-function-1 168 ;; Add the usage form at the end where describe-function-1
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 8822c03c103..5a3fd7dddb1 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -630,10 +630,10 @@
630 (while (eq (car-safe form) 'progn) 630 (while (eq (car-safe form) 'progn)
631 (setq form (car (last (cdr form))))) 631 (setq form (car (last (cdr form)))))
632 (cond ((consp form) 632 (cond ((consp form)
633 (cl-case (car form) 633 (pcase (car form)
634 (quote (cadr form)) 634 (`quote (cadr form))
635 ;; Can't use recursion in a defsubst. 635 ;; Can't use recursion in a defsubst.
636 ;; (progn (byte-compile-trueconstp (car (last (cdr form))))) 636 ;; (`progn (byte-compile-trueconstp (car (last (cdr form)))))
637 )) 637 ))
638 ((not (symbolp form))) 638 ((not (symbolp form)))
639 ((eq form t)) 639 ((eq form t))
@@ -644,10 +644,10 @@
644 (while (eq (car-safe form) 'progn) 644 (while (eq (car-safe form) 'progn)
645 (setq form (car (last (cdr form))))) 645 (setq form (car (last (cdr form)))))
646 (cond ((consp form) 646 (cond ((consp form)
647 (cl-case (car form) 647 (pcase (car form)
648 (quote (null (cadr form))) 648 (`quote (null (cadr form)))
649 ;; Can't use recursion in a defsubst. 649 ;; Can't use recursion in a defsubst.
650 ;; (progn (byte-compile-nilconstp (car (last (cdr form))))) 650 ;; (`progn (byte-compile-nilconstp (car (last (cdr form)))))
651 )) 651 ))
652 ((not (symbolp form)) nil) 652 ((not (symbolp form)) nil)
653 ((null form)))) 653 ((null form))))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 76b147a4c65..751515beb3e 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1591,10 +1591,11 @@ that already has a `.elc' file."
1591 (not (auto-save-file-name-p source)) 1591 (not (auto-save-file-name-p source))
1592 (not (string-equal dir-locals-file 1592 (not (string-equal dir-locals-file
1593 (file-name-nondirectory source)))) 1593 (file-name-nondirectory source))))
1594 (progn (cl-case (byte-recompile-file source force arg) 1594 (progn (incf
1595 (no-byte-compile (setq skip-count (1+ skip-count))) 1595 (pcase (byte-recompile-file source force arg)
1596 ((t) (setq file-count (1+ file-count))) 1596 (`no-byte-compile skip-count)
1597 ((nil) (setq fail-count (1+ fail-count)))) 1597 (`t file-count)
1598 (_ fail-count)))
1598 (or noninteractive 1599 (or noninteractive
1599 (message "Checking %s..." directory)) 1600 (message "Checking %s..." directory))
1600 (if (not (eq last-dir directory)) 1601 (if (not (eq last-dir directory))
@@ -2974,12 +2975,12 @@ That command is designed for interactive use only" fn))
2974 ;; Old-style byte-code. 2975 ;; Old-style byte-code.
2975 (cl-assert (listp fargs)) 2976 (cl-assert (listp fargs))
2976 (while fargs 2977 (while fargs
2977 (cl-case (car fargs) 2978 (pcase (car fargs)
2978 (&optional (setq fargs (cdr fargs))) 2979 (`&optional (setq fargs (cdr fargs)))
2979 (&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1)) 2980 (`&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1))
2980 (push (cadr fargs) dynbinds) 2981 (push (cadr fargs) dynbinds)
2981 (setq fargs nil)) 2982 (setq fargs nil))
2982 (t (push (pop fargs) dynbinds)))) 2983 (_ (push (pop fargs) dynbinds))))
2983 (unless fmax2 (setq fmax2 (* 2 (length dynbinds))))) 2984 (unless fmax2 (setq fmax2 (* 2 (length dynbinds)))))
2984 (cond 2985 (cond
2985 ((<= (+ alen alen) fmax2) 2986 ((<= (+ alen alen) fmax2)
@@ -3024,10 +3025,10 @@ That command is designed for interactive use only" fn))
3024 (and od 3025 (and od
3025 (not (memq var byte-compile-not-obsolete-vars)) 3026 (not (memq var byte-compile-not-obsolete-vars))
3026 (not (memq var byte-compile-global-not-obsolete-vars)) 3027 (not (memq var byte-compile-global-not-obsolete-vars))
3027 (or (cl-case (nth 1 od) 3028 (or (pcase (nth 1 od)
3028 (set (not (eq access-type 'reference))) 3029 (`set (not (eq access-type 'reference)))
3029 (get (eq access-type 'reference)) 3030 (`get (eq access-type 'reference))
3030 (t t))))) 3031 (_ t)))))
3031 (byte-compile-warn-obsolete var)))) 3032 (byte-compile-warn-obsolete var))))
3032 3033
3033(defsubst byte-compile-dynamic-variable-op (base-op var) 3034(defsubst byte-compile-dynamic-variable-op (base-op var)
@@ -4351,21 +4352,21 @@ invoked interactively."
4351 (if byte-compile-call-tree-sort 4352 (if byte-compile-call-tree-sort
4352 (setq byte-compile-call-tree 4353 (setq byte-compile-call-tree
4353 (sort byte-compile-call-tree 4354 (sort byte-compile-call-tree
4354 (cl-case byte-compile-call-tree-sort 4355 (pcase byte-compile-call-tree-sort
4355 (callers 4356 (`callers
4356 (lambda (x y) (< (length (nth 1 x)) 4357 (lambda (x y) (< (length (nth 1 x))
4357 (length (nth 1 y))))) 4358 (length (nth 1 y)))))
4358 (calls 4359 (`calls
4359 (lambda (x y) (< (length (nth 2 x)) 4360 (lambda (x y) (< (length (nth 2 x))
4360 (length (nth 2 y))))) 4361 (length (nth 2 y)))))
4361 (calls+callers 4362 (`calls+callers
4362 (lambda (x y) (< (+ (length (nth 1 x)) 4363 (lambda (x y) (< (+ (length (nth 1 x))
4363 (length (nth 2 x))) 4364 (length (nth 2 x)))
4364 (+ (length (nth 1 y)) 4365 (+ (length (nth 1 y))
4365 (length (nth 2 y)))))) 4366 (length (nth 2 y))))))
4366 (name 4367 (`name
4367 (lambda (x y) (string< (car x) (car y)))) 4368 (lambda (x y) (string< (car x) (car y))))
4368 (t (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode" 4369 (_ (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode"
4369 byte-compile-call-tree-sort)))))) 4370 byte-compile-call-tree-sort))))))
4370 (message "Generating call tree...") 4371 (message "Generating call tree...")
4371 (let ((rest byte-compile-call-tree) 4372 (let ((rest byte-compile-call-tree)
diff --git a/lisp/emulation/crisp.el b/lisp/emulation/crisp.el
index cfb8ed07595..d29736d6860 100644
--- a/lisp/emulation/crisp.el
+++ b/lisp/emulation/crisp.el
@@ -54,8 +54,6 @@
54 54
55;;; Code: 55;;; Code:
56 56
57(eval-when-compile (require 'cl))
58
59;; local variables 57;; local variables
60 58
61(defgroup crisp nil 59(defgroup crisp nil
@@ -361,7 +359,7 @@ if ARG is omitted or nil."
361 (when crisp-mode 359 (when crisp-mode
362 ;; Make menu entries show M-u or f14 in preference to C-x u. 360 ;; Make menu entries show M-u or f14 in preference to C-x u.
363 (put 'undo :advertised-binding 361 (put 'undo :advertised-binding
364 (list* [?\M-u] [f14] (get 'undo :advertised-binding))) 362 `([?\M-u] [f14] ,@(get 'undo :advertised-binding)))
365 ;; Force transient-mark-mode, so that the marking routines work as 363 ;; Force transient-mark-mode, so that the marking routines work as
366 ;; expected. If the user turns off transient mark mode, most 364 ;; expected. If the user turns off transient mark mode, most
367 ;; things will still work fine except the crisp-(copy|kill) 365 ;; things will still work fine except the crisp-(copy|kill)
diff --git a/lisp/face-remap.el b/lisp/face-remap.el
index e2f9e3d2bd2..09503d7c154 100644
--- a/lisp/face-remap.el
+++ b/lisp/face-remap.el
@@ -315,9 +315,9 @@ a top-level keymap, `text-scale-increase' or
315 (let* ((base (event-basic-type ev)) 315 (let* ((base (event-basic-type ev))
316 (step 316 (step
317 (pcase base 317 (pcase base
318 ((or `?+ `?=) inc) 318 ((or ?+ ?=) inc)
319 (`?- (- inc)) 319 (?- (- inc))
320 (`?0 0) 320 (?0 0)
321 (t inc)))) 321 (t inc))))
322 (text-scale-increase step) 322 (text-scale-increase step)
323 ;; FIXME: do it after every "iteration of the loop". 323 ;; FIXME: do it after every "iteration of the loop".
diff --git a/lisp/filesets.el b/lisp/filesets.el
index 86ebe47580b..6c24a4f43d6 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -88,9 +88,7 @@
88 88
89;;; Code: 89;;; Code:
90 90
91(eval-when-compile 91(eval-when-compile (require 'cl-lib))
92 (require 'cl))
93
94 92
95;;; Some variables 93;;; Some variables
96 94
@@ -1286,11 +1284,11 @@ on-close-all ... Not used"
1286 (or entry 1284 (or entry
1287 (filesets-get-external-viewer filename))))) 1285 (filesets-get-external-viewer filename)))))
1288 (filesets-alist-get def 1286 (filesets-alist-get def
1289 (case event 1287 (pcase event
1290 ((on-open-all) ':ignore-on-open-all) 1288 (`on-open-all ':ignore-on-open-all)
1291 ((on-grep) ':ignore-on-read-text) 1289 (`on-grep ':ignore-on-read-text)
1292 ((on-cmd) nil) 1290 (`on-cmd nil)
1293 ((on-close-all) nil)) 1291 (`on-close-all nil))
1294 nil t))) 1292 nil t)))
1295 1293
1296(defun filesets-filetype-get-prop (property filename &optional entry) 1294(defun filesets-filetype-get-prop (property filename &optional entry)
@@ -1559,11 +1557,9 @@ SAVE-FUNCTION takes no argument, but works on the current buffer."
1559 1557
1560(defun filesets-get-fileset-from-name (name &optional mode) 1558(defun filesets-get-fileset-from-name (name &optional mode)
1561 "Get fileset definition for NAME." 1559 "Get fileset definition for NAME."
1562 (case mode 1560 (pcase mode
1563 ((:ingroup :tree) 1561 ((or `:ingroup `:tree) name)
1564 name) 1562 (_ (assoc name filesets-data))))
1565 (t
1566 (assoc name filesets-data))))
1567 1563
1568 1564
1569;;; commands 1565;;; commands
@@ -1720,22 +1716,22 @@ Replace <file-name> or <<file-name>> with filename."
1720Assume MODE (see `filesets-entry-mode'), if provided." 1716Assume MODE (see `filesets-entry-mode'), if provided."
1721 (let* ((mode (or mode 1717 (let* ((mode (or mode
1722 (filesets-entry-mode entry))) 1718 (filesets-entry-mode entry)))
1723 (fl (case mode 1719 (fl (pcase mode
1724 ((:files) 1720 (:files
1725 (filesets-entry-get-files entry)) 1721 (filesets-entry-get-files entry))
1726 ((:file) 1722 (:file
1727 (list (filesets-entry-get-file entry))) 1723 (list (filesets-entry-get-file entry)))
1728 ((:ingroup) 1724 (:ingroup
1729 (let ((entry (expand-file-name 1725 (let ((entry (expand-file-name
1730 (if (stringp entry) 1726 (if (stringp entry)
1731 entry 1727 entry
1732 (filesets-entry-get-master entry))))) 1728 (filesets-entry-get-master entry)))))
1733 (cons entry (filesets-ingroup-cache-get entry)))) 1729 (cons entry (filesets-ingroup-cache-get entry))))
1734 ((:tree) 1730 (:tree
1735 (let ((dir (nth 0 entry)) 1731 (let ((dir (nth 0 entry))
1736 (patt (nth 1 entry))) 1732 (patt (nth 1 entry)))
1737 (filesets-directory-files dir patt ':files t))) 1733 (filesets-directory-files dir patt ':files t)))
1738 ((:pattern) 1734 (:pattern
1739 (let ((dirpatt (filesets-entry-get-pattern entry))) 1735 (let ((dirpatt (filesets-entry-get-pattern entry)))
1740 (if dirpatt 1736 (if dirpatt
1741 (let ((dir (filesets-entry-get-pattern--dir dirpatt)) 1737 (let ((dir (filesets-entry-get-pattern--dir dirpatt))
@@ -1904,12 +1900,12 @@ User will be queried, if no fileset name is provided."
1904 (let* ((result nil) 1900 (let* ((result nil)
1905 (factor (ceiling (/ (float bl) 1901 (factor (ceiling (/ (float bl)
1906 filesets-max-submenu-length)))) 1902 filesets-max-submenu-length))))
1907 (do ((data submenu-body (cdr data)) 1903 (cl-do ((data submenu-body (cdr data))
1908 (n 1 (+ n 1)) 1904 (n 1 (+ n 1))
1909 (count 0 (+ count factor))) 1905 (count 0 (+ count factor)))
1910 ((or (> count bl) 1906 ((or (> count bl)
1911 (null data))) 1907 (null data)))
1912; (let ((sl (subseq submenu-body count 1908 ;; (let ((sl (subseq submenu-body count
1913 (let ((sl (filesets-sublist submenu-body count 1909 (let ((sl (filesets-sublist submenu-body count
1914 (let ((x (+ count factor))) 1910 (let ((x (+ count factor)))
1915 (if (>= bl x) 1911 (if (>= bl x)
@@ -1926,7 +1922,7 @@ User will be queried, if no fileset name is provided."
1926 `((,(concat 1922 `((,(concat
1927 (filesets-get-shortcut n) 1923 (filesets-get-shortcut n)
1928 (let ((rv "")) 1924 (let ((rv ""))
1929 (do ((x sl (cdr x))) 1925 (cl-do ((x sl (cdr x)))
1930 ((null x)) 1926 ((null x))
1931 (let ((y (concat (elt (car x) 0) 1927 (let ((y (concat (elt (car x) 0)
1932 (if (null (cdr x)) 1928 (if (null (cdr x))
@@ -1952,8 +1948,8 @@ User will be queried, if no fileset name is provided."
1952 "Get submenu epilog for SOMETHING (usually a fileset). 1948 "Get submenu epilog for SOMETHING (usually a fileset).
1953If mode is :tree or :ingroup, SOMETHING is some weird construct and 1949If mode is :tree or :ingroup, SOMETHING is some weird construct and
1954LOOKUP-NAME is used as lookup name for retrieving fileset specific settings." 1950LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
1955 (case mode 1951 (pcase mode
1956 ((:tree) 1952 (:tree
1957 `("---" 1953 `("---"
1958 ["Close all files" (filesets-close ',mode ',something ',lookup-name)] 1954 ["Close all files" (filesets-close ',mode ',something ',lookup-name)]
1959 ["Run Command" (filesets-run-cmd nil ',something ',mode)] 1955 ["Run Command" (filesets-run-cmd nil ',something ',mode)]
@@ -1962,14 +1958,14 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
1962 ,@(when rebuild-flag 1958 ,@(when rebuild-flag
1963 `(["Rebuild this submenu" 1959 `(["Rebuild this submenu"
1964 (filesets-rebuild-this-submenu ',lookup-name)])))) 1960 (filesets-rebuild-this-submenu ',lookup-name)]))))
1965 ((:ingroup) 1961 (:ingroup
1966 `("---" 1962 `("---"
1967 ["Close all files" (filesets-close ',mode ',something ',lookup-name)] 1963 ["Close all files" (filesets-close ',mode ',something ',lookup-name)]
1968 ["Run Command" (filesets-run-cmd nil ',something ',mode)] 1964 ["Run Command" (filesets-run-cmd nil ',something ',mode)]
1969 ,@(when rebuild-flag 1965 ,@(when rebuild-flag
1970 `(["Rebuild this submenu" 1966 `(["Rebuild this submenu"
1971 (filesets-rebuild-this-submenu ',lookup-name)])))) 1967 (filesets-rebuild-this-submenu ',lookup-name)]))))
1972 ((:pattern) 1968 (:pattern
1973 `("---" 1969 `("---"
1974 ["Close all files" (filesets-close ',mode ',something)] 1970 ["Close all files" (filesets-close ',mode ',something)]
1975 ["Run Command" (filesets-run-cmd nil ',something ',mode)] 1971 ["Run Command" (filesets-run-cmd nil ',something ',mode)]
@@ -1986,7 +1982,7 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
1986 ,@(when rebuild-flag 1982 ,@(when rebuild-flag
1987 `(["Rebuild this submenu" 1983 `(["Rebuild this submenu"
1988 (filesets-rebuild-this-submenu ',lookup-name)])))) 1984 (filesets-rebuild-this-submenu ',lookup-name)]))))
1989 ((:files) 1985 (:files
1990 `("---" 1986 `("---"
1991 [,(concat "Close all files") (filesets-close ',mode ',something)] 1987 [,(concat "Close all files") (filesets-close ',mode ',something)]
1992 ["Run Command" (filesets-run-cmd nil ',something ',mode)] 1988 ["Run Command" (filesets-run-cmd nil ',something ',mode)]
@@ -1997,7 +1993,7 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
1997 ,@(when rebuild-flag 1993 ,@(when rebuild-flag
1998 `(["Rebuild this submenu" 1994 `(["Rebuild this submenu"
1999 (filesets-rebuild-this-submenu ',lookup-name)])))) 1995 (filesets-rebuild-this-submenu ',lookup-name)]))))
2000 (t 1996 (_
2001 (filesets-error 'error "Filesets: malformed definition of " something)))) 1997 (filesets-error 'error "Filesets: malformed definition of " something))))
2002 1998
2003(defun filesets-ingroup-get-data (master pos &optional fun) 1999(defun filesets-ingroup-get-data (master pos &optional fun)
@@ -2249,15 +2245,15 @@ Construct a shortcut from COUNT."
2249 (filesets-verbosity (filesets-entry-get-verbosity entry)) 2245 (filesets-verbosity (filesets-entry-get-verbosity entry))
2250 (this-lookup-name (concat (filesets-get-shortcut count) 2246 (this-lookup-name (concat (filesets-get-shortcut count)
2251 lookup-name))) 2247 lookup-name)))
2252 (case mode 2248 (pcase mode
2253 ((:file) 2249 (:file
2254 (let* ((file (filesets-entry-get-file entry))) 2250 (let* ((file (filesets-entry-get-file entry)))
2255 `[,this-lookup-name 2251 `[,this-lookup-name
2256 (filesets-file-open nil ',file ',lookup-name)])) 2252 (filesets-file-open nil ',file ',lookup-name)]))
2257 (t 2253 (_
2258 `(,this-lookup-name 2254 `(,this-lookup-name
2259 ,@(case mode 2255 ,@(pcase mode
2260 ((:pattern) 2256 (:pattern
2261 (let* ((files (filesets-get-filelist entry mode 'on-ls)) 2257 (let* ((files (filesets-get-filelist entry mode 'on-ls))
2262 (dirpatt (filesets-entry-get-pattern entry)) 2258 (dirpatt (filesets-entry-get-pattern entry))
2263 (pattname (apply 'concat (cons "Pattern: " dirpatt))) 2259 (pattname (apply 'concat (cons "Pattern: " dirpatt)))
@@ -2276,7 +2272,7 @@ Construct a shortcut from COUNT."
2276 files)) 2272 files))
2277 ,@(filesets-get-menu-epilog lookup-name mode 2273 ,@(filesets-get-menu-epilog lookup-name mode
2278 lookup-name t)))) 2274 lookup-name t))))
2279 ((:ingroup) 2275 (:ingroup
2280 (let* ((master (filesets-entry-get-master entry))) 2276 (let* ((master (filesets-entry-get-master entry)))
2281 ;;(filesets-message 3 "Filesets: parsing %S" master) 2277 ;;(filesets-message 3 "Filesets: parsing %S" master)
2282 `([,(concat "Inclusion Group: " 2278 `([,(concat "Inclusion Group: "
@@ -2288,12 +2284,12 @@ Construct a shortcut from COUNT."
2288 ,@(filesets-wrap-submenu 2284 ,@(filesets-wrap-submenu
2289 (filesets-build-ingroup-submenu lookup-name master)) 2285 (filesets-build-ingroup-submenu lookup-name master))
2290 ,@(filesets-get-menu-epilog master mode lookup-name t)))) 2286 ,@(filesets-get-menu-epilog master mode lookup-name t))))
2291 ((:tree) 2287 (:tree
2292 (let* ((dirpatt (filesets-entry-get-tree entry)) 2288 (let* ((dirpatt (filesets-entry-get-tree entry))
2293 (dir (car dirpatt)) 2289 (dir (car dirpatt))
2294 (patt (cadr dirpatt))) 2290 (patt (cadr dirpatt)))
2295 (filesets-build-dir-submenu entry lookup-name dir patt))) 2291 (filesets-build-dir-submenu entry lookup-name dir patt)))
2296 ((:files) 2292 (:files
2297 (let ((files (filesets-get-filelist entry mode 'on-open-all)) 2293 (let ((files (filesets-get-filelist entry mode 'on-open-all))
2298 (count 0)) 2294 (count 0))
2299 `([,(concat "Files: " lookup-name) 2295 `([,(concat "Files: " lookup-name)
@@ -2331,9 +2327,9 @@ bottom up, set `filesets-submenus' to nil, first.)"
2331 (setq filesets-has-changed-flag nil) 2327 (setq filesets-has-changed-flag nil)
2332 (setq filesets-updated-buffers nil) 2328 (setq filesets-updated-buffers nil)
2333 (setq filesets-update-cache-file-flag t) 2329 (setq filesets-update-cache-file-flag t)
2334 (do ((data (filesets-conditional-sort filesets-data (function car)) 2330 (cl-do ((data (filesets-conditional-sort filesets-data (function car))
2335 (cdr data)) 2331 (cdr data))
2336 (count 1 (+ count 1))) 2332 (count 1 (+ count 1)))
2337 ((null data)) 2333 ((null data))
2338 (let* ((this (car data)) 2334 (let* ((this (car data))
2339 (name (filesets-data-get-name this)) 2335 (name (filesets-data-get-name this))
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index de2e043a56a..f3e313e9c35 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -207,7 +207,7 @@
207;;; Code: 207;;; Code:
208 208
209(require 'syntax) 209(require 'syntax)
210(eval-when-compile (require 'cl)) 210(eval-when-compile (require 'cl-lib))
211 211
212;; Define core `font-lock' group. 212;; Define core `font-lock' group.
213(defgroup font-lock '((jit-lock custom-group)) 213(defgroup font-lock '((jit-lock custom-group))
@@ -614,9 +614,6 @@ Major/minor modes can set this variable if they know which option applies.")
614 614
615(eval-when-compile 615(eval-when-compile
616 ;; 616 ;;
617 ;; We don't do this at the top-level as we only use non-autoloaded macros.
618 (require 'cl)
619 ;;
620 ;; Borrowed from lazy-lock.el. 617 ;; Borrowed from lazy-lock.el.
621 ;; We use this to preserve or protect things when modifying text properties. 618 ;; We use this to preserve or protect things when modifying text properties.
622 (defmacro save-buffer-state (&rest body) 619 (defmacro save-buffer-state (&rest body)
@@ -917,10 +914,10 @@ The value of this variable is used when Font Lock mode is turned on."
917(declare-function lazy-lock-mode "lazy-lock") 914(declare-function lazy-lock-mode "lazy-lock")
918 915
919(defun font-lock-turn-on-thing-lock () 916(defun font-lock-turn-on-thing-lock ()
920 (case (font-lock-value-in-major-mode font-lock-support-mode) 917 (pcase (font-lock-value-in-major-mode font-lock-support-mode)
921 (fast-lock-mode (fast-lock-mode t)) 918 (`fast-lock-mode (fast-lock-mode t))
922 (lazy-lock-mode (lazy-lock-mode t)) 919 (`lazy-lock-mode (lazy-lock-mode t))
923 (jit-lock-mode 920 (`jit-lock-mode
924 ;; Prepare for jit-lock 921 ;; Prepare for jit-lock
925 (remove-hook 'after-change-functions 922 (remove-hook 'after-change-functions
926 'font-lock-after-change-function t) 923 'font-lock-after-change-function t)
@@ -1654,7 +1651,7 @@ LOUDLY, if non-nil, allows progress-meter bar."
1654 ;; Fontify each item in `font-lock-keywords' from `start' to `end'. 1651 ;; Fontify each item in `font-lock-keywords' from `start' to `end'.
1655 (while keywords 1652 (while keywords
1656 (if loudly (message "Fontifying %s... (regexps..%s)" bufname 1653 (if loudly (message "Fontifying %s... (regexps..%s)" bufname
1657 (make-string (incf count) ?.))) 1654 (make-string (cl-incf count) ?.)))
1658 ;; 1655 ;;
1659 ;; Find an occurrence of `matcher' from `start' to `end'. 1656 ;; Find an occurrence of `matcher' from `start' to `end'.
1660 (setq keyword (car keywords) matcher (car keyword)) 1657 (setq keyword (car keywords) matcher (car keyword))
diff --git a/lisp/frame.el b/lisp/frame.el
index 43704d3f20d..778028390e7 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -25,8 +25,6 @@
25;;; Commentary: 25;;; Commentary:
26 26
27;;; Code: 27;;; Code:
28(eval-when-compile (require 'cl))
29
30(defvar frame-creation-function-alist 28(defvar frame-creation-function-alist
31 (list (cons nil 29 (list (cons nil
32 (if (fboundp 'tty-create-frame-with-faces) 30 (if (fboundp 'tty-create-frame-with-faces)
diff --git a/lisp/hexl.el b/lisp/hexl.el
index a754a151fb7..fcdef742cab 100644
--- a/lisp/hexl.el
+++ b/lisp/hexl.el
@@ -41,7 +41,7 @@
41;;; Code: 41;;; Code:
42 42
43(require 'eldoc) 43(require 'eldoc)
44(eval-when-compile (require 'cl)) 44(eval-when-compile (require 'cl)) ;For letf (default-value 'major-mode).
45 45
46;; 46;;
47;; vars here 47;; vars here
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 46ce6aa14d3..fabc12c0219 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -34,7 +34,7 @@
34;;; Code: 34;;; Code:
35 35
36(require 'image) 36(require 'image)
37(eval-when-compile (require 'cl)) 37(eval-when-compile (require 'cl-lib))
38 38
39;;; Image mode window-info management. 39;;; Image mode window-info management.
40 40
@@ -70,12 +70,11 @@ A winprops object has the shape (WINDOW . ALIST)."
70 winprops)) 70 winprops))
71 71
72(defun image-mode-window-get (prop &optional winprops) 72(defun image-mode-window-get (prop &optional winprops)
73 (declare (gv-setter (lambda (val)
74 `(image-mode-window-put ,prop ,val ,winprops))))
73 (unless (consp winprops) (setq winprops (image-mode-winprops winprops))) 75 (unless (consp winprops) (setq winprops (image-mode-winprops winprops)))
74 (cdr (assq prop (cdr winprops)))) 76 (cdr (assq prop (cdr winprops))))
75 77
76(defsetf image-mode-window-get (prop &optional winprops) (val)
77 `(image-mode-window-put ,prop ,val ,winprops))
78
79(defun image-mode-window-put (prop val &optional winprops) 78(defun image-mode-window-put (prop val &optional winprops)
80 (unless (consp winprops) (setq winprops (image-mode-winprops winprops))) 79 (unless (consp winprops) (setq winprops (image-mode-winprops winprops)))
81 (setcdr winprops (cons (cons prop val) 80 (setcdr winprops (cons (cons prop val)
@@ -692,20 +691,20 @@ a slightly different angle. Currently this is done for values
692close to a multiple of 90, see `image-transform-right-angle-fudge'." 691close to a multiple of 90, see `image-transform-right-angle-fudge'."
693 (cond ((< (abs (- (mod (+ image-transform-rotation 90) 180) 90)) 692 (cond ((< (abs (- (mod (+ image-transform-rotation 90) 180) 90))
694 image-transform-right-angle-fudge) 693 image-transform-right-angle-fudge)
695 (assert (not (zerop width)) t) 694 (cl-assert (not (zerop width)) t)
696 (setq image-transform-rotation 695 (setq image-transform-rotation
697 (float (round image-transform-rotation)) 696 (float (round image-transform-rotation))
698 image-transform-scale (/ (float length) width)) 697 image-transform-scale (/ (float length) width))
699 (cons length nil)) 698 (cons length nil))
700 ((< (abs (- (mod (+ image-transform-rotation 45) 90) 45)) 699 ((< (abs (- (mod (+ image-transform-rotation 45) 90) 45))
701 image-transform-right-angle-fudge) 700 image-transform-right-angle-fudge)
702 (assert (not (zerop height)) t) 701 (cl-assert (not (zerop height)) t)
703 (setq image-transform-rotation 702 (setq image-transform-rotation
704 (float (round image-transform-rotation)) 703 (float (round image-transform-rotation))
705 image-transform-scale (/ (float length) height)) 704 image-transform-scale (/ (float length) height))
706 (cons nil length)) 705 (cons nil length))
707 (t 706 (t
708 (assert (not (and (zerop width) (zerop height))) t) 707 (cl-assert (not (and (zerop width) (zerop height))) t)
709 (setq image-transform-scale 708 (setq image-transform-scale
710 (/ (float (1- length)) (image-transform-width width height))) 709 (/ (float (1- length)) (image-transform-width width height)))
711 ;; Assume we have a w x h image and an angle A, and let l = 710 ;; Assume we have a w x h image and an angle A, and let l =
@@ -743,12 +742,12 @@ close to a multiple of 90, see `image-transform-right-angle-fudge'."
743 (unless (numberp image-transform-resize) 742 (unless (numberp image-transform-resize)
744 (let ((size (image-display-size (image-get-display-property) t))) 743 (let ((size (image-display-size (image-get-display-property) t)))
745 (cond ((eq image-transform-resize 'fit-width) 744 (cond ((eq image-transform-resize 'fit-width)
746 (assert (= (car size) 745 (cl-assert (= (car size)
747 (- (nth 2 (window-inside-pixel-edges)) 746 (- (nth 2 (window-inside-pixel-edges))
748 (nth 0 (window-inside-pixel-edges)))) 747 (nth 0 (window-inside-pixel-edges))))
749 t)) 748 t))
750 ((eq image-transform-resize 'fit-height) 749 ((eq image-transform-resize 'fit-height)
751 (assert (= (cdr size) 750 (cl-assert (= (cdr size)
752 (- (nth 3 (window-inside-pixel-edges)) 751 (- (nth 3 (window-inside-pixel-edges))
753 (nth 1 (window-inside-pixel-edges)))) 752 (nth 1 (window-inside-pixel-edges))))
754 t)))))) 753 t))))))
diff --git a/lisp/imenu.el b/lisp/imenu.el
index 24beb9c89c1..8cef5161a37 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -59,7 +59,7 @@
59 59
60;;; Code: 60;;; Code:
61 61
62(eval-when-compile (require 'cl)) 62(eval-when-compile (require 'cl-lib))
63 63
64;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 64;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
65;;; 65;;;
@@ -481,7 +481,7 @@ The returned list DOES NOT share structure with LIST."
481 (i 0)) 481 (i 0))
482 (while remain 482 (while remain
483 (push (pop remain) sublist) 483 (push (pop remain) sublist)
484 (incf i) 484 (cl-incf i)
485 (and (= i n) 485 (and (= i n)
486 ;; We have finished a sublist 486 ;; We have finished a sublist
487 (progn (push (nreverse sublist) result) 487 (progn (push (nreverse sublist) result)
@@ -593,17 +593,17 @@ Non-nil arguments are in recursive calls."
593 t)) 593 t))
594 594
595(defun imenu--create-keymap (title alist &optional cmd) 595(defun imenu--create-keymap (title alist &optional cmd)
596 (list* 'keymap title 596 `(keymap ,title
597 (mapcar 597 ,@(mapcar
598 (lambda (item) 598 (lambda (item)
599 (list* (car item) (car item) 599 `(,(car item) ,(car item)
600 (cond 600 ,@(cond
601 ((imenu--subalist-p item) 601 ((imenu--subalist-p item)
602 (imenu--create-keymap (car item) (cdr item) cmd)) 602 (imenu--create-keymap (car item) (cdr item) cmd))
603 (t 603 (t
604 `(lambda () (interactive) 604 `(lambda () (interactive)
605 ,(if cmd `(,cmd ',item) (list 'quote item))))))) 605 ,(if cmd `(,cmd ',item) (list 'quote item)))))))
606 alist))) 606 alist)))
607 607
608(defun imenu--in-alist (str alist) 608(defun imenu--in-alist (str alist)
609 "Check whether the string STR is contained in multi-level ALIST." 609 "Check whether the string STR is contained in multi-level ALIST."
diff --git a/lisp/info-xref.el b/lisp/info-xref.el
index 69ec00ce09d..ebe50551a69 100644
--- a/lisp/info-xref.el
+++ b/lisp/info-xref.el
@@ -45,8 +45,7 @@
45;;; Code: 45;;; Code:
46 46
47(require 'info) 47(require 'info)
48(eval-when-compile 48(eval-when-compile (require 'cl-lib)) ;; for `incf'
49 (require 'cl)) ;; for `incf'
50 49
51;;----------------------------------------------------------------------------- 50;;-----------------------------------------------------------------------------
52;; vaguely generic 51;; vaguely generic
@@ -239,11 +238,11 @@ buffer's line and column of point."
239 238
240 ;; if the file exists, try the node 239 ;; if the file exists, try the node
241 (cond ((not (cdr (assoc file info-xref-xfile-alist))) 240 (cond ((not (cdr (assoc file info-xref-xfile-alist)))
242 (incf info-xref-unavail)) 241 (cl-incf info-xref-unavail))
243 ((info-xref-goto-node-p node) 242 ((info-xref-goto-node-p node)
244 (incf info-xref-good)) 243 (cl-incf info-xref-good))
245 (t 244 (t
246 (incf info-xref-bad) 245 (cl-incf info-xref-bad)
247 (info-xref-output-error "no such node: %s" node))))))) 246 (info-xref-output-error "no such node: %s" node)))))))
248 247
249 248
@@ -447,8 +446,8 @@ and can take a long time."
447 (if (eq :tag (cadr link)) 446 (if (eq :tag (cadr link))
448 (setq link (cddr link))) 447 (setq link (cddr link)))
449 (if (info-xref-goto-node-p (cadr link)) 448 (if (info-xref-goto-node-p (cadr link))
450 (incf info-xref-good) 449 (cl-incf info-xref-good)
451 (incf info-xref-bad) 450 (cl-incf info-xref-bad)
452 ;; symbol-file gives nil for preloaded variables, would need 451 ;; symbol-file gives nil for preloaded variables, would need
453 ;; to copy what describe-variable does to show the right place 452 ;; to copy what describe-variable does to show the right place
454 (info-xref-output "Symbol `%s' (file %s): cannot goto node: %s" 453 (info-xref-output "Symbol `%s' (file %s): cannot goto node: %s"
diff --git a/lisp/info.el b/lisp/info.el
index 0afb3f01339..163e0af161a 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -32,8 +32,6 @@
32 32
33;;; Code: 33;;; Code:
34 34
35(eval-when-compile (require 'cl))
36
37(defgroup info nil 35(defgroup info nil
38 "Info subsystem." 36 "Info subsystem."
39 :group 'help 37 :group 'help
diff --git a/lisp/international/iso-ascii.el b/lisp/international/iso-ascii.el
index 0566b8ead5c..536cd231753 100644
--- a/lisp/international/iso-ascii.el
+++ b/lisp/international/iso-ascii.el
@@ -32,7 +32,6 @@
32;;; Code: 32;;; Code:
33 33
34(require 'disp-table) 34(require 'disp-table)
35(eval-when-compile (require 'cl))
36 35
37(defgroup iso-ascii nil 36(defgroup iso-ascii nil
38 "Set up char tables for ISO 8859/1 on ASCII terminals." 37 "Set up char tables for ISO 8859/1 on ASCII terminals."
@@ -167,9 +166,14 @@
167With a prefix argument ARG, enable the mode if ARG is positive, 166With a prefix argument ARG, enable the mode if ARG is positive,
168and disable it otherwise. If called from Lisp, enable the mode 167and disable it otherwise. If called from Lisp, enable the mode
169if ARG is omitted or nil." 168if ARG is omitted or nil."
170 :variable (eq standard-display-table iso-ascii-display-table) 169 :variable ((eq standard-display-table iso-ascii-display-table)
171 (unless standard-display-table 170 . (lambda (v)
172 (setq standard-display-table iso-ascii-standard-display-table))) 171 (setq standard-display-table
172 (cond
173 (v iso-ascii-display-table)
174 ((eq standard-display-table iso-ascii-display-table)
175 iso-ascii-standard-display-table)
176 (t standard-display-table))))))
173 177
174(provide 'iso-ascii) 178(provide 'iso-ascii)
175 179
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index 4d69e2fdbcb..fecc9427731 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -53,7 +53,7 @@
53;;; Code: 53;;; Code:
54 54
55(require 'help-mode) 55(require 'help-mode)
56(eval-when-compile (require 'cl)) 56(eval-when-compile (require 'cl-lib))
57 57
58(defgroup quail nil 58(defgroup quail nil
59 "Quail: multilingual input method." 59 "Quail: multilingual input method."
@@ -2395,10 +2395,10 @@ should be made by `quail-build-decode-map' (which see)."
2395 (let ((last-col-elt (or (nth (1- (* (1+ col) newrows)) 2395 (let ((last-col-elt (or (nth (1- (* (1+ col) newrows))
2396 single-list) 2396 single-list)
2397 (car (last single-list))))) 2397 (car (last single-list)))))
2398 (incf width (+ (max 3 (length (car last-col-elt))) 2398 (cl-incf width (+ (max 3 (length (car last-col-elt)))
2399 1 single-trans-width 1)))) 2399 1 single-trans-width 1))))
2400 (< width window-width)) 2400 (< width window-width))
2401 (incf cols)) 2401 (cl-incf cols))
2402 (setq rows (/ (+ len cols -1) cols)) ;Round up. 2402 (setq rows (/ (+ len cols -1) cols)) ;Round up.
2403 (let ((key-width (max 3 (length (car (nth (1- rows) single-list)))))) 2403 (let ((key-width (max 3 (length (car (nth (1- rows) single-list))))))
2404 (insert "key") 2404 (insert "key")
diff --git a/lisp/international/ucs-normalize.el b/lisp/international/ucs-normalize.el
index cc75cc21cbe..54566e1d004 100644
--- a/lisp/international/ucs-normalize.el
+++ b/lisp/international/ucs-normalize.el
@@ -109,7 +109,7 @@
109 109
110(defconst ucs-normalize-version "1.2") 110(defconst ucs-normalize-version "1.2")
111 111
112(eval-when-compile (require 'cl)) 112(eval-when-compile (require 'cl-lib))
113 113
114(declare-function nfd "ucs-normalize" (char)) 114(declare-function nfd "ucs-normalize" (char))
115 115
@@ -179,7 +179,7 @@
179 (let ((char 0) ccc decomposition) 179 (let ((char 0) ccc decomposition)
180 (mapc 180 (mapc
181 (lambda (start-end) 181 (lambda (start-end)
182 (do ((char (car start-end) (+ char 1))) ((> char (cdr start-end))) 182 (cl-do ((char (car start-end) (+ char 1))) ((> char (cdr start-end)))
183 (setq ccc (ucs-normalize-ccc char)) 183 (setq ccc (ucs-normalize-ccc char))
184 (setq decomposition (get-char-code-property 184 (setq decomposition (get-char-code-property
185 char 'decomposition)) 185 char 'decomposition))
@@ -270,7 +270,7 @@ Note that Hangul are excluded.")
270 (let (decomposition alist) 270 (let (decomposition alist)
271 (mapc 271 (mapc
272 (lambda (start-end) 272 (lambda (start-end)
273 (do ((char (car start-end) (+ char 1))) ((> char (cdr start-end))) 273 (cl-do ((char (car start-end) (+ char 1))) ((> char (cdr start-end)))
274 (setq decomposition (funcall decomposition-function char)) 274 (setq decomposition (funcall decomposition-function char))
275 (if decomposition 275 (if decomposition
276 (setq alist (cons (cons char 276 (setq alist (cons (cons char
@@ -391,7 +391,7 @@ decomposition."
391 (let (entries decomposition composition) 391 (let (entries decomposition composition)
392 (mapc 392 (mapc
393 (lambda (start-end) 393 (lambda (start-end)
394 (do ((i (car start-end) (+ i 1))) ((> i (cdr start-end))) 394 (cl-do ((i (car start-end) (+ i 1))) ((> i (cdr start-end)))
395 (setq decomposition 395 (setq decomposition
396 (string-to-list 396 (string-to-list
397 (with-temp-buffer 397 (with-temp-buffer
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index ec44b17835c..55e25e4c262 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -29,8 +29,6 @@
29 29
30 30
31(eval-when-compile 31(eval-when-compile
32 (require 'cl)
33
34 (defmacro with-buffer-prepared-for-jit-lock (&rest body) 32 (defmacro with-buffer-prepared-for-jit-lock (&rest body)
35 "Execute BODY in current buffer, overriding several variables. 33 "Execute BODY in current buffer, overriding several variables.
36Preserves the `buffer-modified-p' state of the current buffer." 34Preserves the `buffer-modified-p' state of the current buffer."
diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index d5099340a17..88aa9f53b75 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -29,8 +29,6 @@
29 29
30;;; Code: 30;;; Code:
31 31
32(eval-when-compile (require 'cl))
33
34(defun feature-symbols (feature) 32(defun feature-symbols (feature)
35 "Return the file and list of definitions associated with FEATURE. 33 "Return the file and list of definitions associated with FEATURE.
36The value is actually the element of `load-history' 34The value is actually the element of `load-history'
@@ -254,11 +252,11 @@ something strange, such as redefining an Emacs function."
254 252
255 (dolist (x unload-function-defs-list) 253 (dolist (x unload-function-defs-list)
256 (if (consp x) 254 (if (consp x)
257 (case (car x) 255 (pcase (car x)
258 ;; Remove any feature names that this file provided. 256 ;; Remove any feature names that this file provided.
259 (provide 257 (`provide
260 (setq features (delq (cdr x) features))) 258 (setq features (delq (cdr x) features)))
261 ((defun autoload) 259 ((or `defun `autoload)
262 (let ((fun (cdr x))) 260 (let ((fun (cdr x)))
263 (when (fboundp fun) 261 (when (fboundp fun)
264 (when (fboundp 'ad-unadvise) 262 (when (fboundp 'ad-unadvise)
@@ -270,9 +268,9 @@ something strange, such as redefining an Emacs function."
270 ;; (t . SYMBOL) comes before (defun . SYMBOL) 268 ;; (t . SYMBOL) comes before (defun . SYMBOL)
271 ;; and says we should restore SYMBOL's autoload 269 ;; and says we should restore SYMBOL's autoload
272 ;; when we undefine it. 270 ;; when we undefine it.
273 ((t) (setq restore-autoload (cdr x))) 271 (`t (setq restore-autoload (cdr x)))
274 ((require defface) nil) 272 ((or `require `defface) nil)
275 (t (message "Unexpected element %s in load-history" x))) 273 (_ (message "Unexpected element %s in load-history" x)))
276 ;; Kill local values as much as possible. 274 ;; Kill local values as much as possible.
277 (dolist (buf (buffer-list)) 275 (dolist (buf (buffer-list))
278 (with-current-buffer buf 276 (with-current-buffer buf
diff --git a/lisp/lpr.el b/lisp/lpr.el
index 65295a7f860..b31d19b624f 100644
--- a/lisp/lpr.el
+++ b/lisp/lpr.el
@@ -29,8 +29,6 @@
29 29
30;;; Code: 30;;; Code:
31 31
32(eval-when-compile (require 'cl))
33
34;;;###autoload 32;;;###autoload
35(defvar lpr-windows-system 33(defvar lpr-windows-system
36 (memq system-type '(ms-dos windows-nt)) 34 (memq system-type '(ms-dos windows-nt))
@@ -281,10 +279,10 @@ for further customization of the printer command."
281 (if (markerp end) 279 (if (markerp end)
282 (set-marker end nil)) 280 (set-marker end nil))
283 (message "Spooling%s...done%s%s" switch-string 281 (message "Spooling%s...done%s%s" switch-string
284 (case (count-lines (point-min) (point-max)) 282 (pcase (count-lines (point-min) (point-max))
285 (0 "") 283 (0 "")
286 (1 ": ") 284 (1 ": ")
287 (t ":\n")) 285 (_ ":\n"))
288 (buffer-string))))))) 286 (buffer-string)))))))
289 287
290;; This function copies the text between start and end 288;; This function copies the text between start and end
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index e20106e1098..5c2c14d1fdb 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -81,7 +81,7 @@
81 81
82;;; Code: 82;;; Code:
83 83
84(eval-when-compile (require 'cl)) 84(eval-when-compile (require 'cl-lib))
85 85
86;;; Completion table manipulation 86;;; Completion table manipulation
87 87
@@ -224,10 +224,10 @@ the form (concat S2 S)."
224 (cond 224 (cond
225 ((eq (car-safe action) 'boundaries) 225 ((eq (car-safe action) 'boundaries)
226 (let ((beg (or (and (eq (car-safe res) 'boundaries) (cadr res)) 0))) 226 (let ((beg (or (and (eq (car-safe res) 'boundaries) (cadr res)) 0)))
227 (list* 'boundaries 227 `(boundaries
228 (max (length s1) 228 ,(max (length s1)
229 (+ beg (- (length s1) (length s2)))) 229 (+ beg (- (length s1) (length s2))))
230 (and (eq (car-safe res) 'boundaries) (cddr res))))) 230 . ,(and (eq (car-safe res) 'boundaries) (cddr res)))))
231 ((stringp res) 231 ((stringp res)
232 (if (eq t (compare-strings res 0 (length s2) s2 nil nil 232 (if (eq t (compare-strings res 0 (length s2) s2 nil nil
233 completion-ignore-case)) 233 completion-ignore-case))
@@ -267,7 +267,7 @@ the form (concat S2 S)."
267 (if (eq (car-safe action) 'boundaries) 267 (if (eq (car-safe action) 'boundaries)
268 (let* ((len (length prefix)) 268 (let* ((len (length prefix))
269 (bound (completion-boundaries string table pred (cdr action)))) 269 (bound (completion-boundaries string table pred (cdr action))))
270 (list* 'boundaries (+ (car bound) len) (cdr bound))) 270 `(boundaries ,(+ (car bound) len) . ,(cdr bound)))
271 (let ((comp (complete-with-action action table string pred))) 271 (let ((comp (complete-with-action action table string pred)))
272 (cond 272 (cond
273 ;; In case of try-completion, add the prefix. 273 ;; In case of try-completion, add the prefix.
@@ -300,8 +300,8 @@ instead of a string, a function that takes the completion and returns the
300 (cdr terminator) (regexp-quote terminator))) 300 (cdr terminator) (regexp-quote terminator)))
301 (max (and terminator-regexp 301 (max (and terminator-regexp
302 (string-match terminator-regexp suffix)))) 302 (string-match terminator-regexp suffix))))
303 (list* 'boundaries (car bounds) 303 `(boundaries ,(car bounds)
304 (min (cdr bounds) (or max (length suffix)))))) 304 . ,(min (cdr bounds) (or max (length suffix))))))
305 ((eq action nil) 305 ((eq action nil)
306 (let ((comp (try-completion string table pred))) 306 (let ((comp (try-completion string table pred)))
307 (if (consp terminator) (setq terminator (car terminator))) 307 (if (consp terminator) (setq terminator (car terminator)))
@@ -408,7 +408,7 @@ for use at QPOS."
408 (qsuffix (cdr action)) 408 (qsuffix (cdr action))
409 (ufull (if (zerop (length qsuffix)) ustring 409 (ufull (if (zerop (length qsuffix)) ustring
410 (funcall unquote (concat string qsuffix)))) 410 (funcall unquote (concat string qsuffix))))
411 (_ (assert (string-prefix-p ustring ufull))) 411 (_ (cl-assert (string-prefix-p ustring ufull)))
412 (usuffix (substring ufull (length ustring))) 412 (usuffix (substring ufull (length ustring)))
413 (boundaries (completion-boundaries ustring table pred usuffix)) 413 (boundaries (completion-boundaries ustring table pred usuffix))
414 (qlboundary (car (funcall requote (car boundaries) string))) 414 (qlboundary (car (funcall requote (car boundaries) string)))
@@ -418,7 +418,7 @@ for use at QPOS."
418 (- (car (funcall requote urfullboundary 418 (- (car (funcall requote urfullboundary
419 (concat string qsuffix))) 419 (concat string qsuffix)))
420 (length string)))))) 420 (length string))))))
421 (list* 'boundaries qlboundary qrboundary))) 421 `(boundaries ,qlboundary . ,qrboundary)))
422 422
423 ;; In "normal" use a c-t-with-quoting completion table should never be 423 ;; In "normal" use a c-t-with-quoting completion table should never be
424 ;; called with action in (t nil) because `completion--unquote' should have 424 ;; called with action in (t nil) because `completion--unquote' should have
@@ -466,18 +466,18 @@ for use at QPOS."
466 (let ((ustring (funcall unquote string)) 466 (let ((ustring (funcall unquote string))
467 (uprefix (funcall unquote (substring string 0 pred)))) 467 (uprefix (funcall unquote (substring string 0 pred))))
468 ;; We presume (more or less) that `concat' and `unquote' commute. 468 ;; We presume (more or less) that `concat' and `unquote' commute.
469 (assert (string-prefix-p uprefix ustring)) 469 (cl-assert (string-prefix-p uprefix ustring))
470 (list ustring table (length uprefix) 470 (list ustring table (length uprefix)
471 (lambda (unquoted-result op) 471 (lambda (unquoted-result op)
472 (pcase op 472 (pcase op
473 (`1 ;;try 473 (1 ;;try
474 (if (not (stringp (car-safe unquoted-result))) 474 (if (not (stringp (car-safe unquoted-result)))
475 unquoted-result 475 unquoted-result
476 (completion--twq-try 476 (completion--twq-try
477 string ustring 477 string ustring
478 (car unquoted-result) (cdr unquoted-result) 478 (car unquoted-result) (cdr unquoted-result)
479 unquote requote))) 479 unquote requote)))
480 (`2 ;;all 480 (2 ;;all
481 (let* ((last (last unquoted-result)) 481 (let* ((last (last unquoted-result))
482 (base (or (cdr last) 0))) 482 (base (or (cdr last) 0)))
483 (when last 483 (when last
@@ -527,12 +527,12 @@ for use at QPOS."
527 (`(,qfullpos . ,qfun) 527 (`(,qfullpos . ,qfun)
528 (funcall requote (+ boundary (length prefix)) string)) 528 (funcall requote (+ boundary (length prefix)) string))
529 (qfullprefix (substring string 0 qfullpos)) 529 (qfullprefix (substring string 0 qfullpos))
530 (_ (assert (completion--string-equal-p 530 (_ (cl-assert (completion--string-equal-p
531 (funcall unquote qfullprefix) 531 (funcall unquote qfullprefix)
532 (concat (substring ustring 0 boundary) prefix)) 532 (concat (substring ustring 0 boundary) prefix))
533 t)) 533 t))
534 (qboundary (car (funcall requote boundary string))) 534 (qboundary (car (funcall requote boundary string)))
535 (_ (assert (<= qboundary qfullpos))) 535 (_ (cl-assert (<= qboundary qfullpos)))
536 ;; FIXME: this split/quote/concat business messes up the carefully 536 ;; FIXME: this split/quote/concat business messes up the carefully
537 ;; placed completions-common-part and completions-first-difference 537 ;; placed completions-common-part and completions-first-difference
538 ;; faces. We could try within the mapcar loop to search for the 538 ;; faces. We could try within the mapcar loop to search for the
@@ -555,11 +555,11 @@ for use at QPOS."
555 ;; which only get quoted when needed by choose-completion. 555 ;; which only get quoted when needed by choose-completion.
556 (nconc 556 (nconc
557 (mapcar (lambda (completion) 557 (mapcar (lambda (completion)
558 (assert (string-prefix-p prefix completion 'ignore-case) t) 558 (cl-assert (string-prefix-p prefix completion 'ignore-case) t)
559 (let* ((new (substring completion (length prefix))) 559 (let* ((new (substring completion (length prefix)))
560 (qnew (funcall qfun new)) 560 (qnew (funcall qfun new))
561 (qcompletion (concat qprefix qnew))) 561 (qcompletion (concat qprefix qnew)))
562 (assert 562 (cl-assert
563 (completion--string-equal-p 563 (completion--string-equal-p
564 (funcall unquote 564 (funcall unquote
565 (concat (substring string 0 qboundary) 565 (concat (substring string 0 qboundary)
@@ -994,9 +994,9 @@ when the buffer's text is already an exact match."
994 'exact 'unknown)))) 994 'exact 'unknown))))
995 ;; Show the completion table, if requested. 995 ;; Show the completion table, if requested.
996 ((not exact) 996 ((not exact)
997 (if (case completion-auto-help 997 (if (pcase completion-auto-help
998 (lazy (eq this-command last-command)) 998 (`lazy (eq this-command last-command))
999 (t completion-auto-help)) 999 (_ completion-auto-help))
1000 (minibuffer-completion-help) 1000 (minibuffer-completion-help)
1001 (completion--message "Next char not unique"))) 1001 (completion--message "Next char not unique")))
1002 ;; If the last exact completion and this one were the same, it 1002 ;; If the last exact completion and this one were the same, it
@@ -1041,9 +1041,9 @@ scroll the window of possible completions."
1041 ((and completion-cycling completion-all-sorted-completions) 1041 ((and completion-cycling completion-all-sorted-completions)
1042 (minibuffer-force-complete) 1042 (minibuffer-force-complete)
1043 t) 1043 t)
1044 (t (case (completion--do-completion) 1044 (t (pcase (completion--do-completion)
1045 (#b000 nil) 1045 (#b000 nil)
1046 (t t))))) 1046 (_ t)))))
1047 1047
1048(defun completion--cache-all-sorted-completions (comps) 1048(defun completion--cache-all-sorted-completions (comps)
1049 (add-hook 'after-change-functions 1049 (add-hook 'after-change-functions
@@ -1203,15 +1203,15 @@ If `minibuffer-completion-confirm' is `confirm-after-completion',
1203 1203
1204 (t 1204 (t
1205 ;; Call do-completion, but ignore errors. 1205 ;; Call do-completion, but ignore errors.
1206 (case (condition-case nil 1206 (pcase (condition-case nil
1207 (completion--do-completion nil 'expect-exact) 1207 (completion--do-completion nil 'expect-exact)
1208 (error 1)) 1208 (error 1))
1209 ((#b001 #b011) (exit-minibuffer)) 1209 ((or #b001 #b011) (exit-minibuffer))
1210 (#b111 (if (not minibuffer-completion-confirm) 1210 (#b111 (if (not minibuffer-completion-confirm)
1211 (exit-minibuffer) 1211 (exit-minibuffer)
1212 (minibuffer-message "Confirm") 1212 (minibuffer-message "Confirm")
1213 nil)) 1213 nil))
1214 (t nil)))))) 1214 (_ nil))))))
1215 1215
1216(defun completion--try-word-completion (string table predicate point md) 1216(defun completion--try-word-completion (string table predicate point md)
1217 (let ((comp (completion-try-completion string table predicate point md))) 1217 (let ((comp (completion-try-completion string table predicate point md)))
@@ -1306,9 +1306,9 @@ After one word is completed as much as possible, a space or hyphen
1306is added, provided that matches some possible completion. 1306is added, provided that matches some possible completion.
1307Return nil if there is no valid completion, else t." 1307Return nil if there is no valid completion, else t."
1308 (interactive) 1308 (interactive)
1309 (case (completion--do-completion 'completion--try-word-completion) 1309 (pcase (completion--do-completion 'completion--try-word-completion)
1310 (#b000 nil) 1310 (#b000 nil)
1311 (t t))) 1311 (_ t)))
1312 1312
1313(defface completions-annotations '((t :inherit italic)) 1313(defface completions-annotations '((t :inherit italic))
1314 "Face to use for annotations in the *Completions* buffer.") 1314 "Face to use for annotations in the *Completions* buffer.")
@@ -1555,7 +1555,7 @@ variables.")
1555(defun completion--done (string &optional finished message) 1555(defun completion--done (string &optional finished message)
1556 (let* ((exit-fun (plist-get completion-extra-properties :exit-function)) 1556 (let* ((exit-fun (plist-get completion-extra-properties :exit-function))
1557 (pre-msg (and exit-fun (current-message)))) 1557 (pre-msg (and exit-fun (current-message))))
1558 (assert (memq finished '(exact sole finished unknown))) 1558 (cl-assert (memq finished '(exact sole finished unknown)))
1559 ;; FIXME: exit-fun should receive `finished' as a parameter. 1559 ;; FIXME: exit-fun should receive `finished' as a parameter.
1560 (when exit-fun 1560 (when exit-fun
1561 (when (eq finished 'unknown) 1561 (when (eq finished 'unknown)
@@ -1727,7 +1727,7 @@ Return nil if there is no valid completion, else t.
1727Point needs to be somewhere between START and END. 1727Point needs to be somewhere between START and END.
1728PREDICATE (a function called with no arguments) says when to 1728PREDICATE (a function called with no arguments) says when to
1729exit." 1729exit."
1730 (assert (<= start (point)) (<= (point) end)) 1730 (cl-assert (<= start (point)) (<= (point) end))
1731 (with-wrapper-hook 1731 (with-wrapper-hook
1732 ;; FIXME: Maybe we should use this hook to provide a "display 1732 ;; FIXME: Maybe we should use this hook to provide a "display
1733 ;; completions" operation as well. 1733 ;; completions" operation as well.
@@ -1794,7 +1794,7 @@ the mode if ARG is omitted or nil."
1794 (unless (equal "*Completions*" (buffer-name (window-buffer))) 1794 (unless (equal "*Completions*" (buffer-name (window-buffer)))
1795 (minibuffer-hide-completions)) 1795 (minibuffer-hide-completions))
1796 ;; (add-hook 'pre-command-hook #'completion-in-region--prech) 1796 ;; (add-hook 'pre-command-hook #'completion-in-region--prech)
1797 (assert completion-in-region-mode-predicate) 1797 (cl-assert completion-in-region-mode-predicate)
1798 (setq completion-in-region-mode--predicate 1798 (setq completion-in-region-mode--predicate
1799 completion-in-region-mode-predicate) 1799 completion-in-region-mode-predicate)
1800 (add-hook 'post-command-hook #'completion-in-region--postch) 1800 (add-hook 'post-command-hook #'completion-in-region--postch)
@@ -1837,10 +1837,10 @@ a completion function or god knows what else.")
1837 ;; always return the same kind of data, but this breaks down with functions 1837 ;; always return the same kind of data, but this breaks down with functions
1838 ;; like comint-completion-at-point or mh-letter-completion-at-point, which 1838 ;; like comint-completion-at-point or mh-letter-completion-at-point, which
1839 ;; could be sometimes safe and sometimes misbehaving (and sometimes neither). 1839 ;; could be sometimes safe and sometimes misbehaving (and sometimes neither).
1840 (if (case which 1840 (if (pcase which
1841 (all t) 1841 (`all t)
1842 (safe (member fun completion--capf-safe-funs)) 1842 (`safe (member fun completion--capf-safe-funs))
1843 (optimist (not (member fun completion--capf-misbehave-funs)))) 1843 (`optimist (not (member fun completion--capf-misbehave-funs))))
1844 (let ((res (funcall fun))) 1844 (let ((res (funcall fun)))
1845 (cond 1845 (cond
1846 ((and (consp res) (not (functionp res))) 1846 ((and (consp res) (not (functionp res)))
@@ -2046,10 +2046,10 @@ same as `substitute-in-file-name'."
2046 (if (eq action 'metadata) 2046 (if (eq action 'metadata)
2047 '(metadata (category . environment-variable)) 2047 '(metadata (category . environment-variable))
2048 (let ((suffix (cdr action))) 2048 (let ((suffix (cdr action)))
2049 (list* 'boundaries 2049 `(boundaries
2050 (or (match-beginning 2) (match-beginning 1)) 2050 ,(or (match-beginning 2) (match-beginning 1))
2051 (when (string-match "[^[:alnum:]_]" suffix) 2051 . ,(when (string-match "[^[:alnum:]_]" suffix)
2052 (match-beginning 0))))))) 2052 (match-beginning 0)))))))
2053 (t 2053 (t
2054 (if (eq (aref string (1- beg)) ?{) 2054 (if (eq (aref string (1- beg)) ?{)
2055 (setq table (apply-partially 'completion-table-with-terminator 2055 (setq table (apply-partially 'completion-table-with-terminator
@@ -2074,14 +2074,14 @@ same as `substitute-in-file-name'."
2074 ((eq (car-safe action) 'boundaries) 2074 ((eq (car-safe action) 'boundaries)
2075 (let ((start (length (file-name-directory string))) 2075 (let ((start (length (file-name-directory string)))
2076 (end (string-match-p "/" (cdr action)))) 2076 (end (string-match-p "/" (cdr action))))
2077 (list* 'boundaries 2077 `(boundaries
2078 ;; if `string' is "C:" in w32, (file-name-directory string) 2078 ;; if `string' is "C:" in w32, (file-name-directory string)
2079 ;; returns "C:/", so `start' is 3 rather than 2. 2079 ;; returns "C:/", so `start' is 3 rather than 2.
2080 ;; Not quite sure what is The Right Fix, but clipping it 2080 ;; Not quite sure what is The Right Fix, but clipping it
2081 ;; back to 2 will work for this particular case. We'll 2081 ;; back to 2 will work for this particular case. We'll
2082 ;; see if we can come up with a better fix when we bump 2082 ;; see if we can come up with a better fix when we bump
2083 ;; into more such problematic cases. 2083 ;; into more such problematic cases.
2084 (min start (length string)) end))) 2084 ,(min start (length string)) . ,end)))
2085 2085
2086 ((eq action 'lambda) 2086 ((eq action 'lambda)
2087 (if (zerop (length string)) 2087 (if (zerop (length string))
@@ -2663,7 +2663,7 @@ or a symbol, see `completion-pcm--merge-completions'."
2663 (setq p0 (1+ p))) 2663 (setq p0 (1+ p)))
2664 (push 'any pattern) 2664 (push 'any pattern)
2665 (setq p0 p)) 2665 (setq p0 p))
2666 (incf p)) 2666 (cl-incf p))
2667 2667
2668 ;; An empty string might be erroneously added at the beginning. 2668 ;; An empty string might be erroneously added at the beginning.
2669 ;; It should be avoided properly, but it's so easy to remove it here. 2669 ;; It should be avoided properly, but it's so easy to remove it here.
@@ -2688,7 +2688,7 @@ or a symbol, see `completion-pcm--merge-completions'."
2688(defun completion-pcm--all-completions (prefix pattern table pred) 2688(defun completion-pcm--all-completions (prefix pattern table pred)
2689 "Find all completions for PATTERN in TABLE obeying PRED. 2689 "Find all completions for PATTERN in TABLE obeying PRED.
2690PATTERN is as returned by `completion-pcm--string->pattern'." 2690PATTERN is as returned by `completion-pcm--string->pattern'."
2691 ;; (assert (= (car (completion-boundaries prefix table pred "")) 2691 ;; (cl-assert (= (car (completion-boundaries prefix table pred ""))
2692 ;; (length prefix))) 2692 ;; (length prefix)))
2693 ;; Find an initial list of possible completions. 2693 ;; Find an initial list of possible completions.
2694 (if (completion-pcm--pattern-trivial-p pattern) 2694 (if (completion-pcm--pattern-trivial-p pattern)
@@ -2762,9 +2762,9 @@ filter out additional entries (because TABLE might not obey PRED)."
2762 ;; The prefix has no completions at all, so we should try and fix 2762 ;; The prefix has no completions at all, so we should try and fix
2763 ;; that first. 2763 ;; that first.
2764 (let ((substring (substring prefix 0 -1))) 2764 (let ((substring (substring prefix 0 -1)))
2765 (destructuring-bind (subpat suball subprefix _subsuffix) 2765 (pcase-let ((`(,subpat ,suball ,subprefix ,_subsuffix)
2766 (completion-pcm--find-all-completions 2766 (completion-pcm--find-all-completions
2767 substring table pred (length substring) filter) 2767 substring table pred (length substring) filter)))
2768 (let ((sep (aref prefix (1- (length prefix)))) 2768 (let ((sep (aref prefix (1- (length prefix))))
2769 ;; Text that goes between the new submatches and the 2769 ;; Text that goes between the new submatches and the
2770 ;; completion substring. 2770 ;; completion substring.
@@ -2828,8 +2828,8 @@ filter out additional entries (because TABLE might not obey PRED)."
2828 (list pattern all prefix suffix))))) 2828 (list pattern all prefix suffix)))))
2829 2829
2830(defun completion-pcm-all-completions (string table pred point) 2830(defun completion-pcm-all-completions (string table pred point)
2831 (destructuring-bind (pattern all &optional prefix _suffix) 2831 (pcase-let ((`(,pattern ,all ,prefix ,_suffix)
2832 (completion-pcm--find-all-completions string table pred point) 2832 (completion-pcm--find-all-completions string table pred point)))
2833 (when all 2833 (when all
2834 (nconc (completion-pcm--hilit-commonality pattern all) 2834 (nconc (completion-pcm--hilit-commonality pattern all)
2835 (length prefix))))) 2835 (length prefix)))))
@@ -2928,7 +2928,7 @@ the same set of elements."
2928 ;; `any' it could lead to a merged completion that 2928 ;; `any' it could lead to a merged completion that
2929 ;; doesn't itself match the candidates. 2929 ;; doesn't itself match the candidates.
2930 (let ((suffix (completion--common-suffix comps))) 2930 (let ((suffix (completion--common-suffix comps)))
2931 (assert (stringp suffix)) 2931 (cl-assert (stringp suffix))
2932 (unless (equal suffix "") 2932 (unless (equal suffix "")
2933 (push suffix res))))) 2933 (push suffix res)))))
2934 (setq fixed ""))))) 2934 (setq fixed "")))))
@@ -2992,11 +2992,11 @@ the same set of elements."
2992 (cons (concat prefix merged suffix) (+ newpos (length prefix))))))) 2992 (cons (concat prefix merged suffix) (+ newpos (length prefix)))))))
2993 2993
2994(defun completion-pcm-try-completion (string table pred point) 2994(defun completion-pcm-try-completion (string table pred point)
2995 (destructuring-bind (pattern all prefix suffix) 2995 (pcase-let ((`(,pattern ,all ,prefix ,suffix)
2996 (completion-pcm--find-all-completions 2996 (completion-pcm--find-all-completions
2997 string table pred point 2997 string table pred point
2998 (if minibuffer-completing-file-name 2998 (if minibuffer-completing-file-name
2999 'completion-pcm--filename-try-filter)) 2999 'completion-pcm--filename-try-filter))))
3000 (completion-pcm--merge-try pattern all prefix suffix))) 3000 (completion-pcm--merge-try pattern all prefix suffix)))
3001 3001
3002;;; Substring completion 3002;;; Substring completion
@@ -3017,15 +3017,17 @@ the same set of elements."
3017 (list all pattern prefix suffix (car bounds)))) 3017 (list all pattern prefix suffix (car bounds))))
3018 3018
3019(defun completion-substring-try-completion (string table pred point) 3019(defun completion-substring-try-completion (string table pred point)
3020 (destructuring-bind (all pattern prefix suffix _carbounds) 3020 (pcase-let ((`(,all ,pattern ,prefix ,suffix ,_carbounds)
3021 (completion-substring--all-completions string table pred point) 3021 (completion-substring--all-completions
3022 string table pred point)))
3022 (if minibuffer-completing-file-name 3023 (if minibuffer-completing-file-name
3023 (setq all (completion-pcm--filename-try-filter all))) 3024 (setq all (completion-pcm--filename-try-filter all)))
3024 (completion-pcm--merge-try pattern all prefix suffix))) 3025 (completion-pcm--merge-try pattern all prefix suffix)))
3025 3026
3026(defun completion-substring-all-completions (string table pred point) 3027(defun completion-substring-all-completions (string table pred point)
3027 (destructuring-bind (all pattern prefix _suffix _carbounds) 3028 (pcase-let ((`(,all ,pattern ,prefix ,_suffix ,_carbounds)
3028 (completion-substring--all-completions string table pred point) 3029 (completion-substring--all-completions
3030 string table pred point)))
3029 (when all 3031 (when all
3030 (nconc (completion-pcm--hilit-commonality pattern all) 3032 (nconc (completion-pcm--hilit-commonality pattern all)
3031 (length prefix))))) 3033 (length prefix)))))
diff --git a/lisp/mpc.el b/lisp/mpc.el
index a908e4bedac..ff5ce801c63 100644
--- a/lisp/mpc.el
+++ b/lisp/mpc.el
@@ -92,7 +92,7 @@
92;; UI-commands : mpc- 92;; UI-commands : mpc-
93;; internal : mpc-- 93;; internal : mpc--
94 94
95(eval-when-compile (require 'cl)) 95(eval-when-compile (require 'cl-lib))
96 96
97(defgroup mpc () 97(defgroup mpc ()
98 "Client for the Music Player Daemon (mpd)." 98 "Client for the Music Player Daemon (mpd)."
@@ -292,7 +292,7 @@ and HOST defaults to localhost."
292(defconst mpc--proc-alist-to-alists-starters '(file directory)) 292(defconst mpc--proc-alist-to-alists-starters '(file directory))
293 293
294(defun mpc--proc-alist-to-alists (alist) 294(defun mpc--proc-alist-to-alists (alist)
295 (assert (or (null alist) 295 (cl-assert (or (null alist)
296 (memq (caar alist) mpc--proc-alist-to-alists-starters))) 296 (memq (caar alist) mpc--proc-alist-to-alists-starters)))
297 (let ((starter (caar alist)) 297 (let ((starter (caar alist))
298 (alists ()) 298 (alists ())
@@ -457,7 +457,7 @@ to call FUN for any change whatsoever.")
457 (let ((old-status mpc-status)) 457 (let ((old-status mpc-status))
458 ;; Update the alist. 458 ;; Update the alist.
459 (setq mpc-status (mpc-proc-buf-to-alist)) 459 (setq mpc-status (mpc-proc-buf-to-alist))
460 (assert mpc-status) 460 (cl-assert mpc-status)
461 (unless (equal old-status mpc-status) 461 (unless (equal old-status mpc-status)
462 ;; Run the relevant refresher functions. 462 ;; Run the relevant refresher functions.
463 (dolist (pair mpc-status-callbacks) 463 (dolist (pair mpc-status-callbacks)
@@ -544,7 +544,7 @@ Any call to `mpc-status-refresh' may cause it to be restarted."
544;; (defun mpc--queue-pop () 544;; (defun mpc--queue-pop ()
545;; (when mpc-queue ;Can be nil if out of sync. 545;; (when mpc-queue ;Can be nil if out of sync.
546;; (let ((song (car mpc-queue))) 546;; (let ((song (car mpc-queue)))
547;; (assert song) 547;; (cl-assert song)
548;; (push (if (and (consp song) (cddr song)) 548;; (push (if (and (consp song) (cddr song))
549;; ;; The queue's first element is itself a list of 549;; ;; The queue's first element is itself a list of
550;; ;; songs, where the first element isn't itself a song 550;; ;; songs, where the first element isn't itself a song
@@ -553,7 +553,7 @@ Any call to `mpc-status-refresh' may cause it to be restarted."
553;; (prog1 (if (consp song) (cadr song) song) 553;; (prog1 (if (consp song) (cadr song) song)
554;; (setq mpc-queue (cdr mpc-queue)))) 554;; (setq mpc-queue (cdr mpc-queue))))
555;; mpc-queue-back) 555;; mpc-queue-back)
556;; (assert (stringp (car mpc-queue-back)))))) 556;; (cl-assert (stringp (car mpc-queue-back))))))
557 557
558;; (defun mpc--queue-refresh () 558;; (defun mpc--queue-refresh ()
559;; ;; Maintain the queue. 559;; ;; Maintain the queue.
@@ -611,7 +611,7 @@ The songs are returned as alists."
611 (i 0)) 611 (i 0))
612 (mapcar (lambda (s) 612 (mapcar (lambda (s)
613 (prog1 (cons (cons 'Pos (number-to-string i)) s) 613 (prog1 (cons (cons 'Pos (number-to-string i)) s)
614 (incf i))) 614 (cl-incf i)))
615 l))) 615 l)))
616 ((eq tag 'Search) 616 ((eq tag 'Search)
617 (mpc-proc-buf-to-alists 617 (mpc-proc-buf-to-alists
@@ -827,8 +827,8 @@ If PLAYLIST is t or nil or missing, use the main playlist."
827 (list "move" song-pos dest-pos)) 827 (list "move" song-pos dest-pos))
828 (if (< song-pos dest-pos) 828 (if (< song-pos dest-pos)
829 ;; This move has shifted dest-pos by 1. 829 ;; This move has shifted dest-pos by 1.
830 (decf dest-pos)) 830 (cl-decf dest-pos))
831 (incf i))) 831 (cl-incf i)))
832 ;; Sort them from last to first, so the renumbering 832 ;; Sort them from last to first, so the renumbering
833 ;; caused by the earlier deletions affect 833 ;; caused by the earlier deletions affect
834 ;; later ones a bit less. 834 ;; later ones a bit less.
@@ -972,8 +972,8 @@ If PLAYLIST is t or nil or missing, use the main playlist."
972 (right-align (match-end 1)) 972 (right-align (match-end 1))
973 (text 973 (text
974 (if (eq info 'self) (symbol-name tag) 974 (if (eq info 'self) (symbol-name tag)
975 (case tag 975 (pcase tag
976 ((Time Duration) 976 ((or `Time `Duration)
977 (let ((time (cdr (or (assq 'time info) (assq 'Time info))))) 977 (let ((time (cdr (or (assq 'time info) (assq 'Time info)))))
978 (setq pred (list nil)) ;Just assume it's never eq. 978 (setq pred (list nil)) ;Just assume it's never eq.
979 (when time 979 (when time
@@ -981,7 +981,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
981 (string-match ":" time)) 981 (string-match ":" time))
982 (substring time (match-end 0)) 982 (substring time (match-end 0))
983 time))))) 983 time)))))
984 (Cover 984 (`Cover
985 (let* ((dir (file-name-directory (cdr (assq 'file info)))) 985 (let* ((dir (file-name-directory (cdr (assq 'file info))))
986 (cover (concat dir "cover.jpg")) 986 (cover (concat dir "cover.jpg"))
987 (file (condition-case err 987 (file (condition-case err
@@ -1004,7 +1004,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
1004 (mpc-tempfiles-add image tempfile))) 1004 (mpc-tempfiles-add image tempfile)))
1005 (setq size nil) 1005 (setq size nil)
1006 (propertize dir 'display image)))) 1006 (propertize dir 'display image))))
1007 (t (let ((val (cdr (assq tag info)))) 1007 (_ (let ((val (cdr (assq tag info))))
1008 ;; For Streaming URLs, there's no other info 1008 ;; For Streaming URLs, there's no other info
1009 ;; than the URL in `file'. Pretend it's in `Title'. 1009 ;; than the URL in `file'. Pretend it's in `Title'.
1010 (when (and (null val) (eq tag 'Title)) 1010 (when (and (null val) (eq tag 'Title))
@@ -1222,7 +1222,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
1222 (beginning-of-line)) 1222 (beginning-of-line))
1223 1223
1224(defun mpc-select-make-overlay () 1224(defun mpc-select-make-overlay ()
1225 (assert (not (get-char-property (point) 'mpc-select))) 1225 (cl-assert (not (get-char-property (point) 'mpc-select)))
1226 (let ((ol (make-overlay 1226 (let ((ol (make-overlay
1227 (line-beginning-position) (line-beginning-position 2)))) 1227 (line-beginning-position) (line-beginning-position 2))))
1228 (overlay-put ol 'mpc-select t) 1228 (overlay-put ol 'mpc-select t)
@@ -1258,7 +1258,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
1258 (> (overlay-end ol) (point))) 1258 (> (overlay-end ol) (point)))
1259 (delete-overlay ol) 1259 (delete-overlay ol)
1260 (push ol ols))) 1260 (push ol ols)))
1261 (assert (= (1+ (length ols)) (length mpc-select))) 1261 (cl-assert (= (1+ (length ols)) (length mpc-select)))
1262 (setq mpc-select ols))) 1262 (setq mpc-select ols)))
1263 ;; We're trying to select *ALL* additionally to others. 1263 ;; We're trying to select *ALL* additionally to others.
1264 ((mpc-tagbrowser-all-p) nil) 1264 ((mpc-tagbrowser-all-p) nil)
@@ -1286,12 +1286,12 @@ If PLAYLIST is t or nil or missing, use the main playlist."
1286 (while (and (zerop (forward-line 1)) 1286 (while (and (zerop (forward-line 1))
1287 (get-char-property (point) 'mpc-select)) 1287 (get-char-property (point) 'mpc-select))
1288 (setq end (1+ (point))) 1288 (setq end (1+ (point)))
1289 (incf after)) 1289 (cl-incf after))
1290 (goto-char mid) 1290 (goto-char mid)
1291 (while (and (zerop (forward-line -1)) 1291 (while (and (zerop (forward-line -1))
1292 (get-char-property (point) 'mpc-select)) 1292 (get-char-property (point) 'mpc-select))
1293 (setq start (point)) 1293 (setq start (point))
1294 (incf before)) 1294 (cl-incf before))
1295 (if (and (= after 0) (= before 0)) 1295 (if (and (= after 0) (= before 0))
1296 ;; Shortening an already minimum-size region: do nothing. 1296 ;; Shortening an already minimum-size region: do nothing.
1297 nil 1297 nil
@@ -1315,13 +1315,13 @@ If PLAYLIST is t or nil or missing, use the main playlist."
1315 (start (line-beginning-position))) 1315 (start (line-beginning-position)))
1316 (while (and (zerop (forward-line 1)) 1316 (while (and (zerop (forward-line 1))
1317 (not (get-char-property (point) 'mpc-select))) 1317 (not (get-char-property (point) 'mpc-select)))
1318 (incf count)) 1318 (cl-incf count))
1319 (unless (get-char-property (point) 'mpc-select) 1319 (unless (get-char-property (point) 'mpc-select)
1320 (setq count nil)) 1320 (setq count nil))
1321 (goto-char start) 1321 (goto-char start)
1322 (while (and (zerop (forward-line -1)) 1322 (while (and (zerop (forward-line -1))
1323 (not (get-char-property (point) 'mpc-select))) 1323 (not (get-char-property (point) 'mpc-select)))
1324 (incf before)) 1324 (cl-incf before))
1325 (unless (get-char-property (point) 'mpc-select) 1325 (unless (get-char-property (point) 'mpc-select)
1326 (setq before nil)) 1326 (setq before nil))
1327 (when (and before (or (null count) (< before count))) 1327 (when (and before (or (null count) (< before count)))
@@ -1430,7 +1430,7 @@ when constructing the set of constraints."
1430 (mpc-select-save 1430 (mpc-select-save
1431 (widen) 1431 (widen)
1432 (goto-char (point-min)) 1432 (goto-char (point-min))
1433 (assert (looking-at (regexp-quote mpc-tagbrowser-all-name))) 1433 (cl-assert (looking-at (regexp-quote mpc-tagbrowser-all-name)))
1434 (forward-line 1) 1434 (forward-line 1)
1435 (let ((inhibit-read-only t)) 1435 (let ((inhibit-read-only t))
1436 (delete-region (point) (point-max)) 1436 (delete-region (point) (point-max))
@@ -1916,7 +1916,7 @@ This is used so that they can be compared with `eq', which is needed for
1916 (cdr (assq 'file song1)) 1916 (cdr (assq 'file song1))
1917 (cdr (assq 'file song2))))) 1917 (cdr (assq 'file song2)))))
1918 (and (integerp cmp) (< cmp 0))))))) 1918 (and (integerp cmp) (< cmp 0)))))))
1919 (incf totaltime (string-to-number (or (cdr (assq 'Time song)) "0"))) 1919 (cl-incf totaltime (string-to-number (or (cdr (assq 'Time song)) "0")))
1920 (mpc-format mpc-songs-format song) 1920 (mpc-format mpc-songs-format song)
1921 (delete-char (- (skip-chars-backward " "))) ;Remove trailing space. 1921 (delete-char (- (skip-chars-backward " "))) ;Remove trailing space.
1922 (insert "\n") 1922 (insert "\n")
@@ -2040,7 +2040,7 @@ This is used so that they can be compared with `eq', which is needed for
2040 (- (point) (car prev))) 2040 (- (point) (car prev)))
2041 next prev) 2041 next prev)
2042 (or next prev))))) 2042 (or next prev)))))
2043 (assert sn) 2043 (cl-assert sn)
2044 (mpc-proc-cmd (concat "play " sn)))))))))) 2044 (mpc-proc-cmd (concat "play " sn))))))))))
2045 2045
2046(define-derived-mode mpc-songs-mode mpc-mode "MPC-song" 2046(define-derived-mode mpc-songs-mode mpc-mode "MPC-song"
@@ -2155,12 +2155,12 @@ This is used so that they can be compared with `eq', which is needed for
2155 (dolist (song (car context)) 2155 (dolist (song (car context))
2156 (and (zerop (forward-line -1)) 2156 (and (zerop (forward-line -1))
2157 (eq (get-text-property (point) 'mpc-file) song) 2157 (eq (get-text-property (point) 'mpc-file) song)
2158 (incf count))) 2158 (cl-incf count)))
2159 (goto-char pos) 2159 (goto-char pos)
2160 (dolist (song (cdr context)) 2160 (dolist (song (cdr context))
2161 (and (zerop (forward-line 1)) 2161 (and (zerop (forward-line 1))
2162 (eq (get-text-property (point) 'mpc-file) song) 2162 (eq (get-text-property (point) 'mpc-file) song)
2163 (incf count))) 2163 (cl-incf count)))
2164 count)) 2164 count))
2165 2165
2166(defun mpc-songpointer-refresh-hairy () 2166(defun mpc-songpointer-refresh-hairy ()
@@ -2201,13 +2201,13 @@ This is used so that they can be compared with `eq', which is needed for
2201 ((< score context-size) nil) 2201 ((< score context-size) nil)
2202 (t 2202 (t
2203 ;; Score is equal and increasing context might help: try it. 2203 ;; Score is equal and increasing context might help: try it.
2204 (incf context-size) 2204 (cl-incf context-size)
2205 (let ((new-context 2205 (let ((new-context
2206 (mpc-songpointer-context context-size plbuf))) 2206 (mpc-songpointer-context context-size plbuf)))
2207 (if (null new-context) 2207 (if (null new-context)
2208 ;; There isn't more context: choose one arbitrarily 2208 ;; There isn't more context: choose one arbitrarily
2209 ;; and keep looking for a better match elsewhere. 2209 ;; and keep looking for a better match elsewhere.
2210 (decf context-size) 2210 (cl-decf context-size)
2211 (setq context new-context) 2211 (setq context new-context)
2212 (setq score (mpc-songpointer-score context pos)) 2212 (setq score (mpc-songpointer-score context pos))
2213 (save-excursion 2213 (save-excursion
diff --git a/lisp/msb.el b/lisp/msb.el
index 760ff61a876..d9fb2c55d87 100644
--- a/lisp/msb.el
+++ b/lisp/msb.el
@@ -77,13 +77,13 @@
77;; hacked on by Dave Love. 77;; hacked on by Dave Love.
78;;; Code: 78;;; Code:
79 79
80(eval-when-compile (require 'cl)) 80(eval-when-compile (require 'cl-lib))
81 81
82;;; 82;;
83;;; Some example constants to be used for `msb-menu-cond'. See that 83;; Some example constants to be used for `msb-menu-cond'. See that
84;;; variable for more information. Please note that if the condition 84;; variable for more information. Please note that if the condition
85;;; returns `multi', then the buffer can appear in several menus. 85;; returns `multi', then the buffer can appear in several menus.
86;;; 86;;
87(defconst msb--few-menus 87(defconst msb--few-menus
88 '(((and (boundp 'server-buffer-clients) 88 '(((and (boundp 'server-buffer-clients)
89 server-buffer-clients 89 server-buffer-clients
@@ -702,18 +702,18 @@ See `msb-menu-cond' for a description of its elements."
702 (multi-flag nil) 702 (multi-flag nil)
703 function-info-list) 703 function-info-list)
704 (setq function-info-list 704 (setq function-info-list
705 (loop for fi 705 (cl-loop for fi
706 across function-info-vector 706 across function-info-vector
707 if (and (setq result 707 if (and (setq result
708 (eval (aref fi 1))) ;Test CONDITION 708 (eval (aref fi 1))) ;Test CONDITION
709 (not (and (eq result 'no-multi) 709 (not (and (eq result 'no-multi)
710 multi-flag)) 710 multi-flag))
711 (progn (when (eq result 'multi) 711 (progn (when (eq result 'multi)
712 (setq multi-flag t)) 712 (setq multi-flag t))
713 t)) 713 t))
714 collect fi 714 collect fi
715 until (and result 715 until (and result
716 (not (eq result 'multi))))) 716 (not (eq result 'multi)))))
717 (when (and (not function-info-list) 717 (when (and (not function-info-list)
718 (not result)) 718 (not result))
719 (error "No catch-all in msb-menu-cond!")) 719 (error "No catch-all in msb-menu-cond!"))
@@ -817,7 +817,7 @@ results in
817(defun msb--mode-menu-cond () 817(defun msb--mode-menu-cond ()
818 (let ((key msb-modes-key)) 818 (let ((key msb-modes-key))
819 (mapcar (lambda (item) 819 (mapcar (lambda (item)
820 (incf key) 820 (cl-incf key)
821 (list `( eq major-mode (quote ,(car item))) 821 (list `( eq major-mode (quote ,(car item)))
822 key 822 key
823 (concat (cdr item) " (%d)"))) 823 (concat (cdr item) " (%d)")))
@@ -841,18 +841,18 @@ It takes the form ((TITLE . BUFFER-LIST)...)."
841 (> msb-display-most-recently-used 0)) 841 (> msb-display-most-recently-used 0))
842 (let* ((buffers (cdr (buffer-list))) 842 (let* ((buffers (cdr (buffer-list)))
843 (most-recently-used 843 (most-recently-used
844 (loop with n = 0 844 (cl-loop with n = 0
845 for buffer in buffers 845 for buffer in buffers
846 if (with-current-buffer buffer 846 if (with-current-buffer buffer
847 (and (not (msb-invisible-buffer-p)) 847 (and (not (msb-invisible-buffer-p))
848 (not (eq major-mode 'dired-mode)))) 848 (not (eq major-mode 'dired-mode))))
849 collect (with-current-buffer buffer 849 collect (with-current-buffer buffer
850 (cons (funcall msb-item-handling-function 850 (cons (funcall msb-item-handling-function
851 buffer 851 buffer
852 max-buffer-name-length) 852 max-buffer-name-length)
853 buffer)) 853 buffer))
854 and do (incf n) 854 and do (cl-incf n)
855 until (>= n msb-display-most-recently-used)))) 855 until (>= n msb-display-most-recently-used))))
856 (cons (if (stringp msb-most-recently-used-title) 856 (cons (if (stringp msb-most-recently-used-title)
857 (format msb-most-recently-used-title 857 (format msb-most-recently-used-title
858 (length most-recently-used)) 858 (length most-recently-used))
@@ -899,29 +899,29 @@ It takes the form ((TITLE . BUFFER-LIST)...)."
899 (when file-buffers 899 (when file-buffers
900 (setq file-buffers 900 (setq file-buffers
901 (mapcar (lambda (buffer-list) 901 (mapcar (lambda (buffer-list)
902 (list* msb-files-by-directory-sort-key 902 `(,msb-files-by-directory-sort-key
903 (car buffer-list) 903 ,(car buffer-list)
904 (sort 904 ,@(sort
905 (mapcar (lambda (buffer) 905 (mapcar (lambda (buffer)
906 (cons (with-current-buffer buffer 906 (cons (with-current-buffer buffer
907 (funcall 907 (funcall
908 msb-item-handling-function 908 msb-item-handling-function
909 buffer 909 buffer
910 max-buffer-name-length)) 910 max-buffer-name-length))
911 buffer)) 911 buffer))
912 (cdr buffer-list)) 912 (cdr buffer-list))
913 (lambda (item1 item2) 913 (lambda (item1 item2)
914 (string< (car item1) (car item2)))))) 914 (string< (car item1) (car item2))))))
915 (msb--choose-file-menu file-buffers)))) 915 (msb--choose-file-menu file-buffers))))
916 ;; Now make the menu - a list of (TITLE . BUFFER-LIST) 916 ;; Now make the menu - a list of (TITLE . BUFFER-LIST)
917 (let* (menu 917 (let* (menu
918 (most-recently-used 918 (most-recently-used
919 (msb--most-recently-used-menu max-buffer-name-length)) 919 (msb--most-recently-used-menu max-buffer-name-length))
920 (others (nconc file-buffers 920 (others (nconc file-buffers
921 (loop for elt 921 (cl-loop for elt
922 across function-info-vector 922 across function-info-vector
923 for value = (msb--create-sort-item elt) 923 for value = (msb--create-sort-item elt)
924 if value collect value)))) 924 if value collect value))))
925 (setq menu 925 (setq menu
926 (mapcar 'cdr ;Remove the SORT-KEY 926 (mapcar 'cdr ;Remove the SORT-KEY
927 ;; Sort the menus - not the items. 927 ;; Sort the menus - not the items.
@@ -1039,7 +1039,7 @@ variable `msb-menu-cond'."
1039 (tmp-list nil)) 1039 (tmp-list nil))
1040 (while (< count msb-max-menu-items) 1040 (while (< count msb-max-menu-items)
1041 (push (pop list) tmp-list) 1041 (push (pop list) tmp-list)
1042 (incf count)) 1042 (cl-incf count))
1043 (setq tmp-list (nreverse tmp-list)) 1043 (setq tmp-list (nreverse tmp-list))
1044 (setq sub-name (concat (car (car tmp-list)) "...")) 1044 (setq sub-name (concat (car (car tmp-list)) "..."))
1045 (push (nconc (list mcount sub-name 1045 (push (nconc (list mcount sub-name
@@ -1076,7 +1076,7 @@ variable `msb-menu-cond'."
1076 (cons (buffer-name (cdr item)) 1076 (cons (buffer-name (cdr item))
1077 (cons (car item) end))) 1077 (cons (car item) end)))
1078 (cdr sub-menu)))) 1078 (cdr sub-menu))))
1079 (nconc (list (incf mcount) (car sub-menu) 1079 (nconc (list (cl-incf mcount) (car sub-menu)
1080 'keymap (car sub-menu)) 1080 'keymap (car sub-menu))
1081 (msb--split-menus buffers)))))) 1081 (msb--split-menus buffers))))))
1082 raw-menu))) 1082 raw-menu)))
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 7d6dcf37a01..d0200f4cb9d 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -45,8 +45,7 @@
45(defvar dbus-registered-objects-table) 45(defvar dbus-registered-objects-table)
46 46
47;; Pacify byte compiler. 47;; Pacify byte compiler.
48(eval-when-compile 48(eval-when-compile (require 'cl-lib))
49 (require 'cl))
50 49
51(require 'xml) 50(require 'xml)
52 51
@@ -494,20 +493,20 @@ placed in the queue.
494 (dolist (flag flags) 493 (dolist (flag flags)
495 (setq arg 494 (setq arg
496 (+ arg 495 (+ arg
497 (case flag 496 (pcase flag
498 (:allow-replacement 1) 497 (:allow-replacement 1)
499 (:replace-existing 2) 498 (:replace-existing 2)
500 (:do-not-queue 4) 499 (:do-not-queue 4)
501 (t (signal 'wrong-type-argument (list flag))))))) 500 (_ (signal 'wrong-type-argument (list flag)))))))
502 (setq reply (dbus-call-method 501 (setq reply (dbus-call-method
503 bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus 502 bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
504 "RequestName" service arg)) 503 "RequestName" service arg))
505 (case reply 504 (pcase reply
506 (1 :primary-owner) 505 (1 :primary-owner)
507 (2 :in-queue) 506 (2 :in-queue)
508 (3 :exists) 507 (3 :exists)
509 (4 :already-owner) 508 (4 :already-owner)
510 (t (signal 'dbus-error (list "Could not register service" service)))))) 509 (_ (signal 'dbus-error (list "Could not register service" service))))))
511 510
512(defun dbus-unregister-service (bus service) 511(defun dbus-unregister-service (bus service)
513 "Unregister all objects related to SERVICE from D-Bus BUS. 512 "Unregister all objects related to SERVICE from D-Bus BUS.
@@ -536,11 +535,11 @@ queue of this service."
536 (let ((reply (dbus-call-method 535 (let ((reply (dbus-call-method
537 bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus 536 bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
538 "ReleaseName" service))) 537 "ReleaseName" service)))
539 (case reply 538 (pcase reply
540 (1 :released) 539 (1 :released)
541 (2 :non-existent) 540 (2 :non-existent)
542 (3 :not-owner) 541 (3 :not-owner)
543 (t (signal 'dbus-error (list "Could not unregister service" service)))))) 542 (_ (signal 'dbus-error (list "Could not unregister service" service))))))
544 543
545(defun dbus-register-signal 544(defun dbus-register-signal
546 (bus service path interface signal handler &rest args) 545 (bus service path interface signal handler &rest args)
@@ -803,7 +802,7 @@ association to the service from D-Bus."
803 ;; Service. 802 ;; Service.
804 (string-equal service (cadr e)) 803 (string-equal service (cadr e))
805 ;; Non-empty object path. 804 ;; Non-empty object path.
806 (caddr e) 805 (cl-caddr e)
807 (throw :found t))))) 806 (throw :found t)))))
808 dbus-registered-objects-table) 807 dbus-registered-objects-table)
809 nil)))) 808 nil))))
@@ -1383,7 +1382,7 @@ name of the property, and its value. If there are no properties,
1383 bus service path dbus-interface-properties 1382 bus service path dbus-interface-properties
1384 "GetAll" :timeout 500 interface) 1383 "GetAll" :timeout 500 interface)
1385 result) 1384 result)
1386 (add-to-list 'result (cons (car dict) (caadr dict)) 'append))))) 1385 (add-to-list 'result (cons (car dict) (cl-caadr dict)) 'append)))))
1387 1386
1388(defun dbus-register-property 1387(defun dbus-register-property
1389 (bus service path interface property access value 1388 (bus service path interface property access value
@@ -1581,7 +1580,7 @@ and \"org.freedesktop.DBus.Properties.GetAll\", which is slow."
1581 (if (cadr entry2) 1580 (if (cadr entry2)
1582 ;; "sv". 1581 ;; "sv".
1583 (dolist (entry3 (cadr entry2)) 1582 (dolist (entry3 (cadr entry2))
1584 (setcdr entry3 (caadr entry3))) 1583 (setcdr entry3 (cl-caadr entry3)))
1585 (setcdr entry2 nil))))) 1584 (setcdr entry2 nil)))))
1586 1585
1587 ;; Fallback: collect the information. Slooow! 1586 ;; Fallback: collect the information. Slooow!
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index a306384c775..d33480afb28 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -35,7 +35,7 @@
35 35
36;;; Code: 36;;; Code:
37 37
38(eval-when-compile (require 'cl)) 38(eval-when-compile (require 'cl-lib))
39 39
40(defgroup gnutls nil 40(defgroup gnutls nil
41 "Emacs interface to the GnuTLS library." 41 "Emacs interface to the GnuTLS library."
@@ -120,7 +120,7 @@ trust and key files, and priority string."
120(declare-function gnutls-boot "gnutls.c" (proc type proplist)) 120(declare-function gnutls-boot "gnutls.c" (proc type proplist))
121(declare-function gnutls-errorp "gnutls.c" (error)) 121(declare-function gnutls-errorp "gnutls.c" (error))
122 122
123(defun* gnutls-negotiate 123(cl-defun gnutls-negotiate
124 (&rest spec 124 (&rest spec
125 &key process type hostname priority-string 125 &key process type hostname priority-string
126 trustfiles crlfiles keylist min-prime-bits 126 trustfiles crlfiles keylist min-prime-bits
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index c9961a67f3d..b71bfb202db 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -118,7 +118,6 @@
118 118
119;;; Code: 119;;; Code:
120 120
121(eval-when-compile (require 'cl))
122(require 'comint) 121(require 'comint)
123 122
124(defgroup pcomplete nil 123(defgroup pcomplete nil
@@ -875,9 +874,9 @@ component, `default-directory' is used as the basis for completion."
875 ;; The env-var is "out of bounds". 874 ;; The env-var is "out of bounds".
876 (if (eq action t) 875 (if (eq action t)
877 (complete-with-action action table newstring pred) 876 (complete-with-action action table newstring pred)
878 (list* 'boundaries 877 `(boundaries
879 (+ (car bounds) (- orig-length (length newstring))) 878 ,(+ (car bounds) (- orig-length (length newstring)))
880 (cdr bounds))) 879 . ,(cdr bounds)))
881 ;; The env-var is in the file bounds. 880 ;; The env-var is in the file bounds.
882 (if (eq action t) 881 (if (eq action t)
883 (let ((comps (complete-with-action 882 (let ((comps (complete-with-action
@@ -886,9 +885,9 @@ component, `default-directory' is used as the basis for completion."
886 ;; Strip the part of each completion that's actually 885 ;; Strip the part of each completion that's actually
887 ;; coming from the env-var. 886 ;; coming from the env-var.
888 (mapcar (lambda (s) (substring s len)) comps)) 887 (mapcar (lambda (s) (substring s len)) comps))
889 (list* 'boundaries 888 `(boundaries
890 (+ envpos (- orig-length (length newstring))) 889 ,(+ envpos (- orig-length (length newstring)))
891 (cdr bounds)))))))))) 890 . ,(cdr bounds))))))))))
892 891
893(defsubst pcomplete-all-entries (&optional regexp predicate) 892(defsubst pcomplete-all-entries (&optional regexp predicate)
894 "Like `pcomplete-entries', but doesn't ignore any entries." 893 "Like `pcomplete-entries', but doesn't ignore any entries."
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index a07ecfcb3a4..f42f661d86c 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -198,7 +198,7 @@
198 198
199(eval-when-compile 199(eval-when-compile
200 (require 'skeleton) 200 (require 'skeleton)
201 (require 'cl) 201 (require 'cl-lib)
202 (require 'comint)) 202 (require 'comint))
203(require 'executable) 203(require 'executable)
204 204
@@ -987,31 +987,31 @@ subshells can nest."
987 (while (and state (progn (skip-chars-forward "^'\\\\\"`$()" limit) 987 (while (and state (progn (skip-chars-forward "^'\\\\\"`$()" limit)
988 (< (point) limit))) 988 (< (point) limit)))
989 ;; unescape " inside a $( ... ) construct. 989 ;; unescape " inside a $( ... ) construct.
990 (case (char-after) 990 (pcase (char-after)
991 (?\' (case state 991 (?\' (pcase state
992 (double-quote nil) 992 (`double-quote nil)
993 (t (forward-char 1) (skip-chars-forward "^'" limit)))) 993 (_ (forward-char 1) (skip-chars-forward "^'" limit))))
994 (?\\ (forward-char 1)) 994 (?\\ (forward-char 1))
995 (?\" (case state 995 (?\" (pcase state
996 (double-quote (setq state (pop states))) 996 (`double-quote (setq state (pop states)))
997 (t (push state states) (setq state 'double-quote))) 997 (_ (push state states) (setq state 'double-quote)))
998 (if state (put-text-property (point) (1+ (point)) 998 (if state (put-text-property (point) (1+ (point))
999 'syntax-table '(1)))) 999 'syntax-table '(1))))
1000 (?\` (case state 1000 (?\` (pcase state
1001 (backquote (setq state (pop states))) 1001 (`backquote (setq state (pop states)))
1002 (t (push state states) (setq state 'backquote)))) 1002 (_ (push state states) (setq state 'backquote))))
1003 (?\$ (if (not (eq (char-after (1+ (point))) ?\()) 1003 (?\$ (if (not (eq (char-after (1+ (point))) ?\())
1004 nil 1004 nil
1005 (forward-char 1) 1005 (forward-char 1)
1006 (case state 1006 (pcase state
1007 (t (push state states) (setq state 'code))))) 1007 (_ (push state states) (setq state 'code)))))
1008 (?\( (case state 1008 (?\( (pcase state
1009 (double-quote nil) 1009 (`double-quote nil)
1010 (t (push state states) (setq state 'code)))) 1010 (_ (push state states) (setq state 'code))))
1011 (?\) (case state 1011 (?\) (pcase state
1012 (double-quote nil) 1012 (`double-quote nil)
1013 (t (setq state (pop states))))) 1013 (_ (setq state (pop states)))))
1014 (t (error "Internal error in sh-font-lock-quoted-subshell"))) 1014 (_ (error "Internal error in sh-font-lock-quoted-subshell")))
1015 (forward-char 1))))) 1015 (forward-char 1)))))
1016 1016
1017 1017
@@ -1105,7 +1105,6 @@ subshells can nest."
1105 (save-excursion 1105 (save-excursion
1106 (sh-font-lock-quoted-subshell end))))))) 1106 (sh-font-lock-quoted-subshell end)))))))
1107 (point) end)) 1107 (point) end))
1108
1109(defun sh-font-lock-syntactic-face-function (state) 1108(defun sh-font-lock-syntactic-face-function (state)
1110 (let ((q (nth 3 state))) 1109 (let ((q (nth 3 state)))
1111 (if q 1110 (if q
@@ -1649,7 +1648,7 @@ Does not preserve point."
1649 (cond 1648 (cond
1650 ((zerop (length prev)) 1649 ((zerop (length prev))
1651 (if newline 1650 (if newline
1652 (progn (assert words) (setq res 'word)) 1651 (progn (cl-assert words) (setq res 'word))
1653 (setq words t) 1652 (setq words t)
1654 (condition-case nil 1653 (condition-case nil
1655 (forward-sexp -1) 1654 (forward-sexp -1)
@@ -1661,7 +1660,7 @@ Does not preserve point."
1661 ((assoc prev smie-grammar) (setq res 'word)) 1660 ((assoc prev smie-grammar) (setq res 'word))
1662 (t 1661 (t
1663 (if newline 1662 (if newline
1664 (progn (assert words) (setq res 'word)) 1663 (progn (cl-assert words) (setq res 'word))
1665 (setq words t))))) 1664 (setq words t)))))
1666 (eq res 'keyword))) 1665 (eq res 'keyword)))
1667 1666
diff --git a/lisp/register.el b/lisp/register.el
index 44f15e4a69c..21fcff2d148 100644
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -28,7 +28,7 @@
28;; pieces of buffer state to named variables. The entry points are 28;; pieces of buffer state to named variables. The entry points are
29;; documented in the Emacs user's manual. 29;; documented in the Emacs user's manual.
30 30
31(eval-when-compile (require 'cl)) 31(eval-when-compile (require 'cl-lib))
32 32
33(declare-function semantic-insert-foreign-tag "semantic/tag" (foreign-tag)) 33(declare-function semantic-insert-foreign-tag "semantic/tag" (foreign-tag))
34(declare-function semantic-tag-buffer "semantic/tag" (tag)) 34(declare-function semantic-tag-buffer "semantic/tag" (tag))
@@ -52,7 +52,7 @@
52 52
53;;; Code: 53;;; Code:
54 54
55(defstruct 55(cl-defstruct
56 (registerv (:constructor nil) 56 (registerv (:constructor nil)
57 (:constructor registerv--make (&optional data print-func 57 (:constructor registerv--make (&optional data print-func
58 jump-func insert-func)) 58 jump-func insert-func))
@@ -64,7 +64,7 @@
64 (jump-func nil :read-only t) 64 (jump-func nil :read-only t)
65 (insert-func nil :read-only t)) 65 (insert-func nil :read-only t))
66 66
67(defun* registerv-make (data &key print-func jump-func insert-func) 67(cl-defun registerv-make (data &key print-func jump-func insert-func)
68 "Create a register value object. 68 "Create a register value object.
69 69
70DATA can be any value. 70DATA can be any value.
@@ -150,7 +150,7 @@ delete any existing frames that the frame configuration doesn't mention.
150 (let ((val (get-register register))) 150 (let ((val (get-register register)))
151 (cond 151 (cond
152 ((registerv-p val) 152 ((registerv-p val)
153 (assert (registerv-jump-func val) nil 153 (cl-assert (registerv-jump-func val) nil
154 "Don't know how to jump to register %s" 154 "Don't know how to jump to register %s"
155 (single-key-description register)) 155 (single-key-description register))
156 (funcall (registerv-jump-func val) (registerv-data val))) 156 (funcall (registerv-jump-func val) (registerv-data val)))
@@ -325,7 +325,7 @@ Interactively, second arg is non-nil if prefix arg is supplied."
325 (let ((val (get-register register))) 325 (let ((val (get-register register)))
326 (cond 326 (cond
327 ((registerv-p val) 327 ((registerv-p val)
328 (assert (registerv-insert-func val) nil 328 (cl-assert (registerv-insert-func val) nil
329 "Don't know how to insert register %s" 329 "Don't know how to insert register %s"
330 (single-key-description register)) 330 (single-key-description register))
331 (funcall (registerv-insert-func val) (registerv-data val))) 331 (funcall (registerv-insert-func val) (registerv-data val)))
diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el
index c6c7d7ddb8d..0d693c52c81 100644
--- a/lisp/scroll-bar.el
+++ b/lisp/scroll-bar.el
@@ -29,7 +29,7 @@
29;;; Code: 29;;; Code:
30 30
31(require 'mouse) 31(require 'mouse)
32(eval-when-compile (require 'cl)) 32(eval-when-compile (require 'cl-lib))
33 33
34 34
35;;;; Utilities. 35;;;; Utilities.
@@ -112,8 +112,9 @@ Setting the variable with a customization buffer also takes effect."
112;; If it is set again, that is for real. 112;; If it is set again, that is for real.
113(setq scroll-bar-mode-explicit t) 113(setq scroll-bar-mode-explicit t)
114 114
115(defun get-scroll-bar-mode () scroll-bar-mode) 115(defun get-scroll-bar-mode ()
116(defsetf get-scroll-bar-mode set-scroll-bar-mode) 116 (declare (gv-setter set-scroll-bar-mode))
117 scroll-bar-mode)
117 118
118(define-minor-mode scroll-bar-mode 119(define-minor-mode scroll-bar-mode
119 "Toggle vertical scroll bars on all frames (Scroll Bar mode). 120 "Toggle vertical scroll bars on all frames (Scroll Bar mode).
diff --git a/lisp/simple.el b/lisp/simple.el
index e6b4a79b9b2..37e0b48d31d 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -28,8 +28,6 @@
28 28
29;;; Code: 29;;; Code:
30 30
31(eval-when-compile (require 'cl)) ;For define-minor-mode.
32
33(declare-function widget-convert "wid-edit" (type &rest args)) 31(declare-function widget-convert "wid-edit" (type &rest args))
34(declare-function shell-mode "shell" ()) 32(declare-function shell-mode "shell" ())
35 33
diff --git a/lisp/uniquify.el b/lisp/uniquify.el
index 520c4b847dd..3619d499419 100644
--- a/lisp/uniquify.el
+++ b/lisp/uniquify.el
@@ -83,7 +83,7 @@
83 83
84;;; Code: 84;;; Code:
85 85
86(eval-when-compile (require 'cl)) 86(eval-when-compile (require 'cl-lib))
87 87
88;;; User-visible variables 88;;; User-visible variables
89 89
@@ -174,7 +174,7 @@ contains the name of the directory which the buffer is visiting.")
174;;; Utilities 174;;; Utilities
175 175
176;; uniquify-fix-list data structure 176;; uniquify-fix-list data structure
177(defstruct (uniquify-item 177(cl-defstruct (uniquify-item
178 (:constructor nil) (:copier nil) 178 (:constructor nil) (:copier nil)
179 (:constructor uniquify-make-item 179 (:constructor uniquify-make-item
180 (base dirname buffer &optional proposed))) 180 (base dirname buffer &optional proposed)))
@@ -340,7 +340,7 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil."
340 340
341(defun uniquify-get-proposed-name (base dirname &optional depth) 341(defun uniquify-get-proposed-name (base dirname &optional depth)
342 (unless depth (setq depth uniquify-min-dir-content)) 342 (unless depth (setq depth uniquify-min-dir-content))
343 (assert (equal (directory-file-name dirname) dirname)) ;No trailing slash. 343 (cl-assert (equal (directory-file-name dirname) dirname)) ;No trailing slash.
344 344
345 ;; Distinguish directories by adding extra separator. 345 ;; Distinguish directories by adding extra separator.
346 (if (and uniquify-trailing-separator-p 346 (if (and uniquify-trailing-separator-p
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 @@
28 28
29;;; Code: 29;;; Code:
30 30
31(eval-when-compile (require 'cl)) 31(eval-when-compile (require 'cl-lib))
32(require 'pcvs-util) 32(require 'pcvs-util)
33 33
34;;; 34;;;
@@ -165,7 +165,7 @@
165;; Tagelt, tag element 165;; Tagelt, tag element
166;; 166;;
167 167
168(defstruct (cvs-tag 168(cl-defstruct (cvs-tag
169 (:constructor nil) 169 (:constructor nil)
170 (:constructor cvs-tag-make 170 (:constructor cvs-tag-make
171 (vlist &optional name type)) 171 (vlist &optional name type))
@@ -235,9 +235,9 @@ The tree will be printed no closer than column COLUMN."
235 (save-excursion 235 (save-excursion
236 (or (= (forward-line 1) 0) (insert "\n")) 236 (or (= (forward-line 1) 0) (insert "\n"))
237 (cvs-tree-print rest printer column)))) 237 (cvs-tree-print rest printer column))))
238 (assert (>= prefix column)) 238 (cl-assert (>= prefix column))
239 (move-to-column prefix t) 239 (move-to-column prefix t)
240 (assert (eolp)) 240 (cl-assert (eolp))
241 (insert (cvs-car name)) 241 (insert (cvs-car name))
242 (dolist (br (cvs-cdr rev)) 242 (dolist (br (cvs-cdr rev))
243 (let* ((column (current-column)) 243 (let* ((column (current-column))
@@ -258,7 +258,7 @@ The tree will be printed no closer than column COLUMN."
258(defun cvs-tree-merge (tree1 tree2) 258(defun cvs-tree-merge (tree1 tree2)
259 "Merge tags trees TREE1 and TREE2 into one. 259 "Merge tags trees TREE1 and TREE2 into one.
260BEWARE: because of stability issues, this is not a symmetric operation." 260BEWARE: because of stability issues, this is not a symmetric operation."
261 (assert (and (listp tree1) (listp tree2))) 261 (cl-assert (and (listp tree1) (listp tree2)))
262 (cond 262 (cond
263 ((null tree1) tree2) 263 ((null tree1) tree2)
264 ((null tree2) tree1) 264 ((null tree2) tree1)
@@ -273,10 +273,10 @@ BEWARE: because of stability issues, this is not a symmetric operation."
273 (l2 (length vl2))) 273 (l2 (length vl2)))
274 (cond 274 (cond
275 ((= l1 l2) 275 ((= l1 l2)
276 (case (cvs-tag-compare tag1 tag2) 276 (pcase (cvs-tag-compare tag1 tag2)
277 (more1 (list* rev2 (cvs-tree-merge tree1 (cdr tree2)))) 277 (`more1 (cons rev2 (cvs-tree-merge tree1 (cdr tree2))))
278 (more2 (list* rev1 (cvs-tree-merge (cdr tree1) tree2))) 278 (`more2 (cons rev1 (cvs-tree-merge (cdr tree1) tree2)))
279 (equal 279 (`equal
280 (cons (cons (cvs-tag-merge tag1 tag2) 280 (cons (cons (cvs-tag-merge tag1 tag2)
281 (cvs-tree-merge (cvs-cdr rev1) (cvs-cdr rev2))) 281 (cvs-tree-merge (cvs-cdr rev1) (cvs-cdr rev2)))
282 (cvs-tree-merge (cdr tree1) (cdr tree2)))))) 282 (cvs-tree-merge (cdr tree1) (cdr tree2))))))
@@ -399,35 +399,35 @@ the list is a three-string list TAG, KIND, REV."
399Otherwise, default to ASCII chars like +, - and |.") 399Otherwise, default to ASCII chars like +, - and |.")
400 400
401(defconst cvs-tree-char-space 401(defconst cvs-tree-char-space
402 (case cvs-tree-use-charset 402 (pcase cvs-tree-use-charset
403 (jisx0208 (make-char 'japanese-jisx0208 33 33)) 403 (`jisx0208 (make-char 'japanese-jisx0208 33 33))
404 (unicode " ") 404 (`unicode " ")
405 (t " "))) 405 (_ " ")))
406(defconst cvs-tree-char-hbar 406(defconst cvs-tree-char-hbar
407 (case cvs-tree-use-charset 407 (pcase cvs-tree-use-charset
408 (jisx0208 (make-char 'japanese-jisx0208 40 44)) 408 (`jisx0208 (make-char 'japanese-jisx0208 40 44))
409 (unicode "━") 409 (`unicode "━")
410 (t "--"))) 410 (_ "--")))
411(defconst cvs-tree-char-vbar 411(defconst cvs-tree-char-vbar
412 (case cvs-tree-use-charset 412 (pcase cvs-tree-use-charset
413 (jisx0208 (make-char 'japanese-jisx0208 40 45)) 413 (`jisx0208 (make-char 'japanese-jisx0208 40 45))
414 (unicode "┃") 414 (`unicode "┃")
415 (t "| "))) 415 (_ "| ")))
416(defconst cvs-tree-char-branch 416(defconst cvs-tree-char-branch
417 (case cvs-tree-use-charset 417 (pcase cvs-tree-use-charset
418 (jisx0208 (make-char 'japanese-jisx0208 40 50)) 418 (`jisx0208 (make-char 'japanese-jisx0208 40 50))
419 (unicode "┣") 419 (`unicode "┣")
420 (t "+-"))) 420 (_ "+-")))
421(defconst cvs-tree-char-eob ;end of branch 421(defconst cvs-tree-char-eob ;end of branch
422 (case cvs-tree-use-charset 422 (pcase cvs-tree-use-charset
423 (jisx0208 (make-char 'japanese-jisx0208 40 49)) 423 (`jisx0208 (make-char 'japanese-jisx0208 40 49))
424 (unicode "┗") 424 (`unicode "┗")
425 (t "`-"))) 425 (_ "`-")))
426(defconst cvs-tree-char-bob ;beginning of branch 426(defconst cvs-tree-char-bob ;beginning of branch
427 (case cvs-tree-use-charset 427 (pcase cvs-tree-use-charset
428 (jisx0208 (make-char 'japanese-jisx0208 40 51)) 428 (`jisx0208 (make-char 'japanese-jisx0208 40 51))
429 (unicode "┳") 429 (`unicode "┳")
430 (t "+-"))) 430 (_ "+-")))
431 431
432(defun cvs-tag-lessp (tag1 tag2) 432(defun cvs-tag-lessp (tag1 tag2)
433 (eq (cvs-tag-compare tag1 tag2) 'more2)) 433 (eq (cvs-tag-compare tag1 tag2) 'more2))
@@ -485,9 +485,9 @@ Optional prefix ARG chooses between two representations."
485 (pe t) ;"prev equal" 485 (pe t) ;"prev equal"
486 (nas nil)) ;"next afters" to be returned 486 (nas nil)) ;"next afters" to be returned
487 (insert " ") 487 (insert " ")
488 (do* ((vs vlist (cdr vs)) 488 (cl-do* ((vs vlist (cdr vs))
489 (ps prev (cdr ps)) 489 (ps prev (cdr ps))
490 (as after (cdr as))) 490 (as after (cdr as)))
491 ((and (null as) (null vs) (null ps)) 491 ((and (null as) (null vs) (null ps))
492 (let ((revname (cvs-status-vl-to-str vlist))) 492 (let ((revname (cvs-status-vl-to-str vlist)))
493 (if (cvs-every 'identity (cvs-map 'equal prev vlist)) 493 (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 @@
53;; - Handle `diff -b' output in context->unified. 53;; - Handle `diff -b' output in context->unified.
54 54
55;;; Code: 55;;; Code:
56(eval-when-compile (require 'cl)) 56(eval-when-compile (require 'cl-lib))
57 57
58(defvar add-log-buffer-file-name-function) 58(defvar add-log-buffer-file-name-function)
59 59
@@ -493,14 +493,15 @@ See http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01990.html")
493 ;; We may have a first evaluation of `end' thanks to the hunk header. 493 ;; We may have a first evaluation of `end' thanks to the hunk header.
494 (unless end 494 (unless end
495 (setq end (and (re-search-forward 495 (setq end (and (re-search-forward
496 (case style 496 (pcase style
497 (unified (concat (if diff-valid-unified-empty-line 497 (`unified
498 "^[^-+# \\\n]\\|" "^[^-+# \\]\\|") 498 (concat (if diff-valid-unified-empty-line
499 ;; A `unified' header is ambiguous. 499 "^[^-+# \\\n]\\|" "^[^-+# \\]\\|")
500 diff-file-header-re)) 500 ;; A `unified' header is ambiguous.
501 (context "^[^-+#! \\]") 501 diff-file-header-re))
502 (normal "^[^<>#\\]") 502 (`context "^[^-+#! \\]")
503 (t "^[^-+#!<> \\]")) 503 (`normal "^[^<>#\\]")
504 (_ "^[^-+#!<> \\]"))
504 nil t) 505 nil t)
505 (match-beginning 0))) 506 (match-beginning 0)))
506 (when diff-valid-unified-empty-line 507 (when diff-valid-unified-empty-line
@@ -710,7 +711,7 @@ data such as \"Index: ...\" and such."
710 (save-excursion 711 (save-excursion
711 (let ((n 0)) 712 (let ((n 0))
712 (goto-char start) 713 (goto-char start)
713 (while (re-search-forward re end t) (incf n)) 714 (while (re-search-forward re end t) (cl-incf n))
714 n))) 715 n)))
715 716
716(defun diff-splittable-p () 717(defun diff-splittable-p ()
@@ -834,16 +835,16 @@ PREFIX is only used internally: don't use it."
834 ;; use any previously used preference 835 ;; use any previously used preference
835 (cdr (assoc fs diff-remembered-files-alist)) 836 (cdr (assoc fs diff-remembered-files-alist))
836 ;; try to be clever and use previous choices as an inspiration 837 ;; try to be clever and use previous choices as an inspiration
837 (dolist (rf diff-remembered-files-alist) 838 (cl-dolist (rf diff-remembered-files-alist)
838 (let ((newfile (diff-merge-strings (caar rf) (car fs) (cdr rf)))) 839 (let ((newfile (diff-merge-strings (caar rf) (car fs) (cdr rf))))
839 (if (and newfile (file-exists-p newfile)) (return newfile)))) 840 (if (and newfile (file-exists-p newfile)) (cl-return newfile))))
840 ;; look for each file in turn. If none found, try again but 841 ;; look for each file in turn. If none found, try again but
841 ;; ignoring the first level of directory, ... 842 ;; ignoring the first level of directory, ...
842 (do* ((files fs (delq nil (mapcar 'diff-filename-drop-dir files))) 843 (cl-do* ((files fs (delq nil (mapcar 'diff-filename-drop-dir files)))
843 (file nil nil)) 844 (file nil nil))
844 ((or (null files) 845 ((or (null files)
845 (setq file (do* ((files files (cdr files)) 846 (setq file (cl-do* ((files files (cdr files))
846 (file (car files) (car files))) 847 (file (car files) (car files)))
847 ;; Use file-regular-p to avoid 848 ;; Use file-regular-p to avoid
848 ;; /dev/null, directories, etc. 849 ;; /dev/null, directories, etc.
849 ((or (null file) (file-regular-p file)) 850 ((or (null file) (file-regular-p file))
@@ -862,7 +863,7 @@ PREFIX is only used internally: don't use it."
862 (diff-find-file-name old noprompt (match-string 1))) 863 (diff-find-file-name old noprompt (match-string 1)))
863 ;; if all else fails, ask the user 864 ;; if all else fails, ask the user
864 (unless noprompt 865 (unless noprompt
865 (let ((file (expand-file-name (or (first fs) "")))) 866 (let ((file (expand-file-name (or (car fs) ""))))
866 (setq file 867 (setq file
867 (read-file-name (format "Use file %s: " file) 868 (read-file-name (format "Use file %s: " file)
868 (file-name-directory file) file t 869 (file-name-directory file) file t
@@ -940,21 +941,23 @@ else cover the whole buffer."
940 (let ((modif nil) last-pt) 941 (let ((modif nil) last-pt)
941 (while (progn (setq last-pt (point)) 942 (while (progn (setq last-pt (point))
942 (= (forward-line -1) 0)) 943 (= (forward-line -1) 0))
943 (case (char-after) 944 (pcase (char-after)
944 (?\s (insert " ") (setq modif nil) (backward-char 1)) 945 (?\s (insert " ") (setq modif nil) (backward-char 1))
945 (?+ (delete-region (point) last-pt) (setq modif t)) 946 (?+ (delete-region (point) last-pt) (setq modif t))
946 (?- (if (not modif) 947 (?- (if (not modif)
947 (progn (forward-char 1) 948 (progn (forward-char 1)
948 (insert " ")) 949 (insert " "))
949 (delete-char 1) 950 (delete-char 1)
950 (insert "! ")) 951 (insert "! "))
951 (backward-char 2)) 952 (backward-char 2))
952 (?\\ (when (save-excursion (forward-line -1) 953 (?\\ (when (save-excursion (forward-line -1)
953 (= (char-after) ?+)) 954 (= (char-after) ?+))
954 (delete-region (point) last-pt) (setq modif t))) 955 (delete-region (point) last-pt)
956 (setq modif t)))
955 ;; diff-valid-unified-empty-line. 957 ;; diff-valid-unified-empty-line.
956 (?\n (insert " ") (setq modif nil) (backward-char 2)) 958 (?\n (insert " ") (setq modif nil)
957 (t (setq modif nil)))))) 959 (backward-char 2))
960 (_ (setq modif nil))))))
958 (goto-char (point-max)) 961 (goto-char (point-max))
959 (save-excursion 962 (save-excursion
960 (insert "--- " line2 "," 963 (insert "--- " line2 ","
@@ -967,7 +970,8 @@ else cover the whole buffer."
967 (if (not (save-excursion (re-search-forward "^+" nil t))) 970 (if (not (save-excursion (re-search-forward "^+" nil t)))
968 (delete-region (point) (point-max)) 971 (delete-region (point) (point-max))
969 (let ((modif nil) (delete nil)) 972 (let ((modif nil) (delete nil))
970 (if (save-excursion (re-search-forward "^\\+.*\n-" nil t)) 973 (if (save-excursion (re-search-forward "^\\+.*\n-"
974 nil t))
971 ;; Normally, lines in a substitution come with 975 ;; Normally, lines in a substitution come with
972 ;; first the removals and then the additions, and 976 ;; first the removals and then the additions, and
973 ;; the context->unified function follows this 977 ;; the context->unified function follows this
@@ -976,22 +980,22 @@ else cover the whole buffer."
976 ;; context->unified as an undo command. 980 ;; context->unified as an undo command.
977 (setq reversible nil)) 981 (setq reversible nil))
978 (while (not (eobp)) 982 (while (not (eobp))
979 (case (char-after) 983 (pcase (char-after)
980 (?\s (insert " ") (setq modif nil) (backward-char 1)) 984 (?\s (insert " ") (setq modif nil) (backward-char 1))
981 (?- (setq delete t) (setq modif t)) 985 (?- (setq delete t) (setq modif t))
982 (?+ (if (not modif) 986 (?+ (if (not modif)
983 (progn (forward-char 1) 987 (progn (forward-char 1)
984 (insert " ")) 988 (insert " "))
985 (delete-char 1) 989 (delete-char 1)
986 (insert "! ")) 990 (insert "! "))
987 (backward-char 2)) 991 (backward-char 2))
988 (?\\ (when (save-excursion (forward-line 1) 992 (?\\ (when (save-excursion (forward-line 1)
989 (not (eobp))) 993 (not (eobp)))
990 (setq delete t) (setq modif t))) 994 (setq delete t) (setq modif t)))
991 ;; diff-valid-unified-empty-line. 995 ;; diff-valid-unified-empty-line.
992 (?\n (insert " ") (setq modif nil) (backward-char 2) 996 (?\n (insert " ") (setq modif nil) (backward-char 2)
993 (setq reversible nil)) 997 (setq reversible nil))
994 (t (setq modif nil))) 998 (_ (setq modif nil)))
995 (let ((last-pt (point))) 999 (let ((last-pt (point)))
996 (forward-line 1) 1000 (forward-line 1)
997 (when delete 1001 (when delete
@@ -1051,17 +1055,18 @@ With a prefix argument, convert unified format to context format."
1051 (goto-char pt1) 1055 (goto-char pt1)
1052 (forward-line 1) 1056 (forward-line 1)
1053 (while (< (point) pt2) 1057 (while (< (point) pt2)
1054 (case (char-after) 1058 (pcase (char-after)
1055 (?! (delete-char 2) (insert "-") (forward-line 1)) 1059 (?! (delete-char 2) (insert "-") (forward-line 1))
1056 (?- (forward-char 1) (delete-char 1) (forward-line 1)) 1060 (?- (forward-char 1) (delete-char 1) (forward-line 1))
1057 (?\s ;merge with the other half of the chunk 1061 (?\s ;merge with the other half of the chunk
1058 (let* ((endline2 1062 (let* ((endline2
1059 (save-excursion 1063 (save-excursion
1060 (goto-char pt2) (forward-line 1) (point)))) 1064 (goto-char pt2) (forward-line 1) (point))))
1061 (case (char-after pt2) 1065 (pcase (char-after pt2)
1062 ((?! ?+) 1066 ((or ?! ?+)
1063 (insert "+" 1067 (insert "+"
1064 (prog1 (buffer-substring (+ pt2 2) endline2) 1068 (prog1
1069 (buffer-substring (+ pt2 2) endline2)
1065 (delete-region pt2 endline2)))) 1070 (delete-region pt2 endline2))))
1066 (?\s 1071 (?\s
1067 (unless (= (- endline2 pt2) 1072 (unless (= (- endline2 pt2)
@@ -1075,9 +1080,9 @@ With a prefix argument, convert unified format to context format."
1075 (delete-char 1) 1080 (delete-char 1)
1076 (forward-line 1)) 1081 (forward-line 1))
1077 (?\\ (forward-line 1)) 1082 (?\\ (forward-line 1))
1078 (t (setq reversible nil) 1083 (_ (setq reversible nil)
1079 (delete-char 1) (forward-line 1))))) 1084 (delete-char 1) (forward-line 1)))))
1080 (t (setq reversible nil) (forward-line 1)))) 1085 (_ (setq reversible nil) (forward-line 1))))
1081 (while (looking-at "[+! ] ") 1086 (while (looking-at "[+! ] ")
1082 (if (/= (char-after) ?!) (forward-char 1) 1087 (if (/= (char-after) ?!) (forward-char 1)
1083 (delete-char 1) (insert "+")) 1088 (delete-char 1) (insert "+"))
@@ -1155,13 +1160,13 @@ else cover the whole buffer."
1155 (replace-match "@@ -\\8 +\\7 @@" nil) 1160 (replace-match "@@ -\\8 +\\7 @@" nil)
1156 (forward-line 1) 1161 (forward-line 1)
1157 (let ((c (char-after)) first last) 1162 (let ((c (char-after)) first last)
1158 (while (case (setq c (char-after)) 1163 (while (pcase (setq c (char-after))
1159 (?- (setq first (or first (point))) 1164 (?- (setq first (or first (point)))
1160 (delete-char 1) (insert "+") t) 1165 (delete-char 1) (insert "+") t)
1161 (?+ (setq last (or last (point))) 1166 (?+ (setq last (or last (point)))
1162 (delete-char 1) (insert "-") t) 1167 (delete-char 1) (insert "-") t)
1163 ((?\\ ?#) t) 1168 ((or ?\\ ?#) t)
1164 (t (when (and first last (< first last)) 1169 (_ (when (and first last (< first last))
1165 (insert (delete-and-extract-region first last))) 1170 (insert (delete-and-extract-region first last)))
1166 (setq first nil last nil) 1171 (setq first nil last nil)
1167 (memq c (if diff-valid-unified-empty-line 1172 (memq c (if diff-valid-unified-empty-line
@@ -1184,13 +1189,13 @@ else cover the whole buffer."
1184 (concat diff-hunk-header-re-unified 1189 (concat diff-hunk-header-re-unified
1185 "\\|[-*][-*][-*] [0-9,]+ [-*][-*][-*][-*]$" 1190 "\\|[-*][-*][-*] [0-9,]+ [-*][-*][-*][-*]$"
1186 "\\|--- .+\n\\+\\+\\+ "))) 1191 "\\|--- .+\n\\+\\+\\+ ")))
1187 (case (char-after) 1192 (pcase (char-after)
1188 (?\s (incf space)) 1193 (?\s (cl-incf space))
1189 (?+ (incf plus)) 1194 (?+ (cl-incf plus))
1190 (?- (incf minus)) 1195 (?- (cl-incf minus))
1191 (?! (incf bang)) 1196 (?! (cl-incf bang))
1192 ((?\\ ?#) nil) 1197 ((or ?\\ ?#) nil)
1193 (t (setq space 0 plus 0 minus 0 bang 0))) 1198 (_ (setq space 0 plus 0 minus 0 bang 0)))
1194 (cond 1199 (cond
1195 ((looking-at diff-hunk-header-re-unified) 1200 ((looking-at diff-hunk-header-re-unified)
1196 (let* ((old1 (match-string 2)) 1201 (let* ((old1 (match-string 2))
@@ -1432,7 +1437,7 @@ Only works for unified diffs."
1432 (cond 1437 (cond
1433 ((and (memq (char-after) '(?\s ?! ?+ ?-)) 1438 ((and (memq (char-after) '(?\s ?! ?+ ?-))
1434 (memq (char-after (1+ (point))) '(?\s ?\t))) 1439 (memq (char-after (1+ (point))) '(?\s ?\t)))
1435 (decf count) t) 1440 (cl-decf count) t)
1436 ((or (zerop count) (= count lines)) nil) 1441 ((or (zerop count) (= count lines)) nil)
1437 ((memq (char-after) '(?! ?+ ?-)) 1442 ((memq (char-after) '(?! ?+ ?-))
1438 (if (not (and (eq (char-after (1+ (point))) ?\n) 1443 (if (not (and (eq (char-after (1+ (point))) ?\n)
@@ -1483,8 +1488,8 @@ Only works for unified diffs."
1483 (after (string-to-number (or (match-string 4) "1")))) 1488 (after (string-to-number (or (match-string 4) "1"))))
1484 (forward-line) 1489 (forward-line)
1485 (while 1490 (while
1486 (case (char-after) 1491 (pcase (char-after)
1487 (?\s (decf before) (decf after) t) 1492 (?\s (cl-decf before) (cl-decf after) t)
1488 (?- 1493 (?-
1489 (if (and (looking-at diff-file-header-re) 1494 (if (and (looking-at diff-file-header-re)
1490 (zerop before) (zerop after)) 1495 (zerop before) (zerop after))
@@ -1494,15 +1499,15 @@ Only works for unified diffs."
1494 ;; line so that our code which doesn't count lines 1499 ;; line so that our code which doesn't count lines
1495 ;; will not get confused. 1500 ;; will not get confused.
1496 (progn (save-excursion (insert "\n")) nil) 1501 (progn (save-excursion (insert "\n")) nil)
1497 (decf before) t)) 1502 (cl-decf before) t))
1498 (?+ (decf after) t) 1503 (?+ (cl-decf after) t)
1499 (t 1504 (_
1500 (cond 1505 (cond
1501 ((and diff-valid-unified-empty-line 1506 ((and diff-valid-unified-empty-line
1502 ;; Not just (eolp) so we don't infloop at eob. 1507 ;; Not just (eolp) so we don't infloop at eob.
1503 (eq (char-after) ?\n) 1508 (eq (char-after) ?\n)
1504 (> before 0) (> after 0)) 1509 (> before 0) (> after 0))
1505 (decf before) (decf after) t) 1510 (cl-decf before) (cl-decf after) t)
1506 ((and (zerop before) (zerop after)) nil) 1511 ((and (zerop before) (zerop after)) nil)
1507 ((or (< before 0) (< after 0)) 1512 ((or (< before 0) (< after 0))
1508 (error (if (or (zerop before) (zerop after)) 1513 (error (if (or (zerop before) (zerop after))
@@ -1719,16 +1724,17 @@ the value of this variable when given an appropriate prefix argument).
1719 1724
1720With a prefix argument, REVERSE the hunk." 1725With a prefix argument, REVERSE the hunk."
1721 (interactive "P") 1726 (interactive "P")
1722 (destructuring-bind (buf line-offset pos old new &optional switched) 1727 (pcase-let ((`(,buf ,line-offset ,pos ,old ,new ,switched)
1723 ;; Sometimes we'd like to have the following behavior: if REVERSE go 1728 ;; Sometimes we'd like to have the following behavior: if
1724 ;; to the new file, otherwise go to the old. But that means that by 1729 ;; REVERSE go to the new file, otherwise go to the old.
1725 ;; default we use the old file, which is the opposite of the default 1730 ;; But that means that by default we use the old file, which is
1726 ;; for diff-goto-source, and is thus confusing. Also when you don't 1731 ;; the opposite of the default for diff-goto-source, and is thus
1727 ;; know about it it's pretty surprising. 1732 ;; confusing. Also when you don't know about it it's
1728 ;; TODO: make it possible to ask explicitly for this behavior. 1733 ;; pretty surprising.
1729 ;; 1734 ;; TODO: make it possible to ask explicitly for this behavior.
1730 ;; This is duplicated in diff-test-hunk. 1735 ;;
1731 (diff-find-source-location nil reverse) 1736 ;; This is duplicated in diff-test-hunk.
1737 (diff-find-source-location nil reverse)))
1732 (cond 1738 (cond
1733 ((null line-offset) 1739 ((null line-offset)
1734 (error "Can't find the text to patch")) 1740 (error "Can't find the text to patch"))
@@ -1771,8 +1777,8 @@ With a prefix argument, REVERSE the hunk."
1771 "See whether it's possible to apply the current hunk. 1777 "See whether it's possible to apply the current hunk.
1772With a prefix argument, try to REVERSE the hunk." 1778With a prefix argument, try to REVERSE the hunk."
1773 (interactive "P") 1779 (interactive "P")
1774 (destructuring-bind (buf line-offset pos src _dst &optional switched) 1780 (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched)
1775 (diff-find-source-location nil reverse) 1781 (diff-find-source-location nil reverse)))
1776 (set-window-point (display-buffer buf) (+ (car pos) (cdr src))) 1782 (set-window-point (display-buffer buf) (+ (car pos) (cdr src)))
1777 (diff-hunk-status-msg line-offset (diff-xor reverse switched) t))) 1783 (diff-hunk-status-msg line-offset (diff-xor reverse switched) t)))
1778 1784
@@ -1791,8 +1797,8 @@ then `diff-jump-to-old-file' is also set, for the next invocations."
1791 ;; This is a convenient detail when using smerge-diff. 1797 ;; This is a convenient detail when using smerge-diff.
1792 (if event (posn-set-point (event-end event))) 1798 (if event (posn-set-point (event-end event)))
1793 (let ((rev (not (save-excursion (beginning-of-line) (looking-at "[-<]"))))) 1799 (let ((rev (not (save-excursion (beginning-of-line) (looking-at "[-<]")))))
1794 (destructuring-bind (buf line-offset pos src _dst &optional switched) 1800 (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched)
1795 (diff-find-source-location other-file rev) 1801 (diff-find-source-location other-file rev)))
1796 (pop-to-buffer buf) 1802 (pop-to-buffer buf)
1797 (goto-char (+ (car pos) (cdr src))) 1803 (goto-char (+ (car pos) (cdr src)))
1798 (diff-hunk-status-msg line-offset (diff-xor rev switched) t)))) 1804 (diff-hunk-status-msg line-offset (diff-xor rev switched) t))))
@@ -1809,10 +1815,11 @@ For use in `add-log-current-defun-function'."
1809 (when (looking-at diff-hunk-header-re) 1815 (when (looking-at diff-hunk-header-re)
1810 (forward-line 1) 1816 (forward-line 1)
1811 (re-search-forward "^[^ ]" nil t)) 1817 (re-search-forward "^[^ ]" nil t))
1812 (destructuring-bind (&optional buf _line-offset pos src dst switched) 1818 (pcase-let ((`(,buf ,_line-offset ,pos ,src ,dst ,switched)
1813 ;; Use `noprompt' since this is used in which-func-mode and such. 1819 (ignore-errors ;Signals errors in place of prompting.
1814 (ignore-errors ;Signals errors in place of prompting. 1820 ;; Use `noprompt' since this is used in which-func-mode
1815 (diff-find-source-location nil nil 'noprompt)) 1821 ;; and such.
1822 (diff-find-source-location nil nil 'noprompt))))
1816 (when buf 1823 (when buf
1817 (beginning-of-line) 1824 (beginning-of-line)
1818 (or (when (memq (char-after) '(?< ?-)) 1825 (or (when (memq (char-after) '(?< ?-))
@@ -1835,7 +1842,7 @@ For use in `add-log-current-defun-function'."
1835 "Re-diff the current hunk, ignoring whitespace differences." 1842 "Re-diff the current hunk, ignoring whitespace differences."
1836 (interactive) 1843 (interactive)
1837 (let* ((char-offset (- (point) (diff-beginning-of-hunk t))) 1844 (let* ((char-offset (- (point) (diff-beginning-of-hunk t)))
1838 (opts (case (char-after) (?@ "-bu") (?* "-bc") (t "-b"))) 1845 (opts (pcase (char-after) (?@ "-bu") (?* "-bc") (_ "-b")))
1839 (line-nb (and (or (looking-at "[^0-9]+\\([0-9]+\\)") 1846 (line-nb (and (or (looking-at "[^0-9]+\\([0-9]+\\)")
1840 (error "Can't find line number")) 1847 (error "Can't find line number"))
1841 (string-to-number (match-string 1)))) 1848 (string-to-number (match-string 1))))
@@ -1857,13 +1864,13 @@ For use in `add-log-current-defun-function'."
1857 (let ((status 1864 (let ((status
1858 (call-process diff-command nil t nil 1865 (call-process diff-command nil t nil
1859 opts file1 file2))) 1866 opts file1 file2)))
1860 (case status 1867 (pcase status
1861 (0 nil) ;Nothing to reformat. 1868 (0 nil) ;Nothing to reformat.
1862 (1 (goto-char (point-min)) 1869 (1 (goto-char (point-min))
1863 ;; Remove the file-header. 1870 ;; Remove the file-header.
1864 (when (re-search-forward diff-hunk-header-re nil t) 1871 (when (re-search-forward diff-hunk-header-re nil t)
1865 (delete-region (point-min) (match-beginning 0)))) 1872 (delete-region (point-min) (match-beginning 0))))
1866 (t (goto-char (point-max)) 1873 (_ (goto-char (point-max))
1867 (unless (bolp) (insert "\n")) 1874 (unless (bolp) (insert "\n"))
1868 (insert hunk))) 1875 (insert hunk)))
1869 (setq hunk (buffer-string)) 1876 (setq hunk (buffer-string))
@@ -1942,14 +1949,14 @@ For use in `add-log-current-defun-function'."
1942 (remove-overlays beg end 'diff-mode 'fine) 1949 (remove-overlays beg end 'diff-mode 'fine)
1943 1950
1944 (goto-char beg) 1951 (goto-char beg)
1945 (case style 1952 (pcase style
1946 (unified 1953 (`unified
1947 (while (re-search-forward "^\\(?:-.*\n\\)+\\(\\)\\(?:\\+.*\n\\)+" 1954 (while (re-search-forward "^\\(?:-.*\n\\)+\\(\\)\\(?:\\+.*\n\\)+"
1948 end t) 1955 end t)
1949 (smerge-refine-subst (match-beginning 0) (match-end 1) 1956 (smerge-refine-subst (match-beginning 0) (match-end 1)
1950 (match-end 1) (match-end 0) 1957 (match-end 1) (match-end 0)
1951 nil 'diff-refine-preproc props-r props-a))) 1958 nil 'diff-refine-preproc props-r props-a)))
1952 (context 1959 (`context
1953 (let* ((middle (save-excursion (re-search-forward "^---"))) 1960 (let* ((middle (save-excursion (re-search-forward "^---")))
1954 (other middle)) 1961 (other middle))
1955 (while (re-search-forward "^\\(?:!.*\n\\)+" middle t) 1962 (while (re-search-forward "^\\(?:!.*\n\\)+" middle t)
@@ -1964,7 +1971,7 @@ For use in `add-log-current-defun-function'."
1964 'diff-refine-preproc 1971 'diff-refine-preproc
1965 (unless diff-use-changed-face props-r) 1972 (unless diff-use-changed-face props-r)
1966 (unless diff-use-changed-face props-a))))) 1973 (unless diff-use-changed-face props-a)))))
1967 (t ;; Normal diffs. 1974 (_ ;; Normal diffs.
1968 (let ((beg1 (1+ (point)))) 1975 (let ((beg1 (1+ (point))))
1969 (when (re-search-forward "^---.*\n" end t) 1976 (when (re-search-forward "^---.*\n" end t)
1970 ;; It's a combined add&remove, so there's something to do. 1977 ;; 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 @@
32 32
33(declare-function diff-setup-whitespace "diff-mode" ()) 33(declare-function diff-setup-whitespace "diff-mode" ())
34 34
35(eval-when-compile (require 'cl))
36
37(defgroup diff nil 35(defgroup diff nil
38 "Comparing files with `diff'." 36 "Comparing files with `diff'."
39 :group 'tools) 37 :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 @@
29 29
30;;; Code: 30;;; Code:
31 31
32(eval-when-compile (require 'cl))
33(require 'add-log) ; for all the ChangeLog goodies 32(require 'add-log) ; for all the ChangeLog goodies
34(require 'pcvs-util) 33(require 'pcvs-util)
35(require 'ring) 34(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 @@
109 109
110;;; Code: 110;;; Code:
111 111
112(eval-when-compile (require 'cl))
113(require 'pcvs-util) 112(require 'pcvs-util)
114(autoload 'vc-find-revision "vc") 113(autoload 'vc-find-revision "vc")
115(autoload 'vc-diff-internal "vc") 114(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 @@
26 26
27;;; Code: 27;;; Code:
28 28
29(eval-when-compile (require 'cl))
30(require 'pcvs-util) 29(require 'pcvs-util)
31 30
32;;;; ------------------------------------------------------- 31;;;; -------------------------------------------------------
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 @@
31 31
32;;; Code: 32;;; Code:
33 33
34(eval-when-compile (require 'cl)) 34(eval-when-compile (require 'cl-lib))
35(require 'pcvs-util) 35(require 'pcvs-util)
36;;(require 'pcvs-defs) 36;;(require 'pcvs-defs)
37 37
@@ -146,7 +146,7 @@ to confuse some users sometimes."
146 146
147;; Constructor: 147;; Constructor:
148 148
149(defstruct (cvs-fileinfo 149(cl-defstruct (cvs-fileinfo
150 (:constructor nil) 150 (:constructor nil)
151 (:copier nil) 151 (:copier nil)
152 (:constructor -cvs-create-fileinfo (type dir file full-log 152 (:constructor -cvs-create-fileinfo (type dir file full-log
@@ -274,10 +274,10 @@ to confuse some users sometimes."
274 (string= file (file-name-nondirectory file))) 274 (string= file (file-name-nondirectory file)))
275 (setq check 'type) (symbolp type) 275 (setq check 'type) (symbolp type)
276 (setq check 'consistency) 276 (setq check 'consistency)
277 (case type 277 (pcase type
278 (DIRCHANGE (and (null subtype) (string= "." file))) 278 (`DIRCHANGE (and (null subtype) (string= "." file)))
279 ((NEED-UPDATE ADDED MISSING DEAD MODIFIED MESSAGE UP-TO-DATE 279 ((or `NEED-UPDATE `ADDED `MISSING `DEAD `MODIFIED `MESSAGE
280 REMOVED NEED-MERGE CONFLICT UNKNOWN MESSAGE) 280 `UP-TO-DATE `REMOVED `NEED-MERGE `CONFLICT `UNKNOWN)
281 t))) 281 t)))
282 fi 282 fi
283 (error "Invalid :%s in cvs-fileinfo %s" check fi)))) 283 (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."
325(defun cvs-add-face (str face &optional keymap &rest props) 325(defun cvs-add-face (str face &optional keymap &rest props)
326 (when keymap 326 (when keymap
327 (when (keymapp keymap) 327 (when (keymapp keymap)
328 (setq props (list* 'keymap keymap props))) 328 (setq props `(keymap ,keymap ,@props)))
329 (setq props (list* 'mouse-face 'highlight props))) 329 (setq props `(mouse-face highlight ,@props)))
330 (add-text-properties 0 (length str) (list* 'font-lock-face face props) str) 330 (add-text-properties 0 (length str) `(font-lock-face ,face ,@props) str)
331 str) 331 str)
332 332
333(defun cvs-fileinfo-pp (fileinfo) 333(defun cvs-fileinfo-pp (fileinfo)
@@ -337,15 +337,15 @@ For use by the cookie package."
337 (let ((type (cvs-fileinfo->type fileinfo)) 337 (let ((type (cvs-fileinfo->type fileinfo))
338 (subtype (cvs-fileinfo->subtype fileinfo))) 338 (subtype (cvs-fileinfo->subtype fileinfo)))
339 (insert 339 (insert
340 (case type 340 (pcase type
341 (DIRCHANGE (concat "In directory " 341 (`DIRCHANGE (concat "In directory "
342 (cvs-add-face (cvs-fileinfo->full-name fileinfo) 342 (cvs-add-face (cvs-fileinfo->full-name fileinfo)
343 'cvs-header t 'cvs-goal-column t) 343 'cvs-header t 'cvs-goal-column t)
344 ":")) 344 ":"))
345 (MESSAGE 345 (`MESSAGE
346 (cvs-add-face (format "Message: %s" (cvs-fileinfo->full-log fileinfo)) 346 (cvs-add-face (format "Message: %s" (cvs-fileinfo->full-log fileinfo))
347 'cvs-msg)) 347 'cvs-msg))
348 (t 348 (_
349 (let* ((status (if (cvs-fileinfo->marked fileinfo) 349 (let* ((status (if (cvs-fileinfo->marked fileinfo)
350 (cvs-add-face "*" 'cvs-marked) 350 (cvs-add-face "*" 'cvs-marked)
351 " ")) 351 " "))
@@ -354,10 +354,10 @@ For use by the cookie package."
354 (base (or (cvs-fileinfo->base-rev fileinfo) "")) 354 (base (or (cvs-fileinfo->base-rev fileinfo) ""))
355 (head (cvs-fileinfo->head-rev fileinfo)) 355 (head (cvs-fileinfo->head-rev fileinfo))
356 (type 356 (type
357 (let ((str (case type 357 (let ((str (pcase type
358 ;;(MOD-CONFLICT "Not Removed") 358 ;;(MOD-CONFLICT "Not Removed")
359 (DEAD "") 359 (`DEAD "")
360 (t (capitalize (symbol-name type))))) 360 (_ (capitalize (symbol-name type)))))
361 (face (let ((sym (intern 361 (face (let ((sym (intern
362 (concat "cvs-fi-" 362 (concat "cvs-fi-"
363 (downcase (symbol-name type)) 363 (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 @@
32 32
33;;; Code: 33;;; Code:
34 34
35(eval-when-compile (require 'cl))
36
37(require 'pcvs-util) 35(require 'pcvs-util)
38(require 'pcvs-info) 36(require 'pcvs-info)
39 37
@@ -117,7 +115,7 @@ If RE matches, advance the point until the line after the match and
117then assign the variables as specified in MATCHES (via `setq')." 115then assign the variables as specified in MATCHES (via `setq')."
118 (cons 'cvs-do-match 116 (cons 'cvs-do-match
119 (cons re (mapcar (lambda (match) 117 (cons re (mapcar (lambda (match)
120 `(cons ',(first match) ,(second match))) 118 `(cons ',(car match) ,(cadr match)))
121 matches)))) 119 matches))))
122 120
123(defun cvs-do-match (re &rest matches) 121(defun cvs-do-match (re &rest matches)
@@ -150,8 +148,8 @@ Match RE and if successful, execute MATCHES."
150 (cvs-or 148 (cvs-or
151 (funcall parse-spec) 149 (funcall parse-spec)
152 150
153 (dolist (re cvs-parse-ignored-messages) 151 (cl-dolist (re cvs-parse-ignored-messages)
154 (when (cvs-match re) (return t))) 152 (when (cvs-match re) (cl-return t)))
155 153
156 ;; This is a parse error. Create a message-type fileinfo. 154 ;; This is a parse error. Create a message-type fileinfo.
157 (and 155 (and
@@ -221,7 +219,7 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
221 ;; ?: Unknown file. 219 ;; ?: Unknown file.
222 (let ((code (aref c 0))) 220 (let ((code (aref c 0)))
223 (cvs-parsed-fileinfo 221 (cvs-parsed-fileinfo
224 (case code 222 (pcase code
225 (?M 'MODIFIED) 223 (?M 'MODIFIED)
226 (?A 'ADDED) 224 (?A 'ADDED)
227 (?R 'REMOVED) 225 (?R 'REMOVED)
@@ -238,7 +236,7 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
238 (if (re-search-forward "^<<<<<<< " nil t) 236 (if (re-search-forward "^<<<<<<< " nil t)
239 'CONFLICT 'NEED-MERGE)))) 237 'CONFLICT 'NEED-MERGE))))
240 (?J 'NEED-MERGE) ;not supported by standard CVS 238 (?J 'NEED-MERGE) ;not supported by standard CVS
241 ((?U ?P) 239 ((or ?U ?P)
242 (if dont-change-disc 'NEED-UPDATE 240 (if dont-change-disc 'NEED-UPDATE
243 (cons 'UP-TO-DATE (if (eq code ?U) 'UPDATED 'PATCHED))))) 241 (cons 'UP-TO-DATE (if (eq code ?U) 'UPDATED 'PATCHED)))))
244 path 'trust))) 242 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 @@
26 26
27;;; Code: 27;;; Code:
28 28
29(eval-when-compile (require 'cl)) 29(eval-when-compile (require 'cl-lib))
30 30
31;;;; 31;;;;
32;;;; list processing 32;;;; list processing
@@ -63,7 +63,7 @@
63 (while (and l (> n 1)) 63 (while (and l (> n 1))
64 (setcdr nl (list (pop l))) 64 (setcdr nl (list (pop l)))
65 (setq nl (cdr nl)) 65 (setq nl (cdr nl))
66 (decf n)) 66 (cl-decf n))
67 ret)))) 67 ret))))
68 68
69(defun cvs-partition (p l) 69(defun cvs-partition (p l)
@@ -130,10 +130,10 @@ If NOREUSE is non-nil, always return a new buffer."
130 (if noreuse (generate-new-buffer name) 130 (if noreuse (generate-new-buffer name)
131 (get-buffer-create name))) 131 (get-buffer-create name)))
132 (unless noreuse 132 (unless noreuse
133 (dolist (buf (buffer-list)) 133 (cl-dolist (buf (buffer-list))
134 (with-current-buffer buf 134 (with-current-buffer buf
135 (when (equal name list-buffers-directory) 135 (when (equal name list-buffers-directory)
136 (return buf))))) 136 (cl-return buf)))))
137 (with-current-buffer (create-file-buffer name) 137 (with-current-buffer (create-file-buffer name)
138 (setq list-buffers-directory name) 138 (setq list-buffers-directory name)
139 (current-buffer)))) 139 (current-buffer))))
@@ -195,10 +195,10 @@ arguments. If ARGS is not a list, no argument will be passed."
195;;;; (interactive <foo>) support function 195;;;; (interactive <foo>) support function
196;;;; 196;;;;
197 197
198(defstruct (cvs-qtypedesc 198(cl-defstruct (cvs-qtypedesc
199 (:constructor nil) (:copier nil) 199 (:constructor nil) (:copier nil)
200 (:constructor cvs-qtypedesc-create 200 (:constructor cvs-qtypedesc-create
201 (str2obj obj2str &optional complete hist-sym require))) 201 (str2obj obj2str &optional complete hist-sym require)))
202 str2obj 202 str2obj
203 obj2str 203 obj2str
204 hist-sym 204 hist-sym
@@ -231,10 +231,10 @@ arguments. If ARGS is not a list, no argument will be passed."
231;;;; Flags handling 231;;;; Flags handling
232;;;; 232;;;;
233 233
234(defstruct (cvs-flags 234(cl-defstruct (cvs-flags
235 (:constructor nil) 235 (:constructor nil)
236 (:constructor -cvs-flags-make 236 (:constructor -cvs-flags-make
237 (desc defaults &optional qtypedesc hist-sym))) 237 (desc defaults &optional qtypedesc hist-sym)))
238 defaults persist desc qtypedesc hist-sym) 238 defaults persist desc qtypedesc hist-sym)
239 239
240(defmacro cvs-flags-define (sym defaults 240(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 @@
118 118
119;;; Code: 119;;; Code:
120 120
121(eval-when-compile (require 'cl)) 121(eval-when-compile (require 'cl-lib))
122(require 'ewoc) ;Ewoc was once cookie 122(require 'ewoc) ;Ewoc was once cookie
123(require 'pcvs-defs) 123(require 'pcvs-defs)
124(require 'pcvs-util) 124(require 'pcvs-util)
@@ -219,21 +219,21 @@
219(autoload 'cvs-status-get-tags "cvs-status") 219(autoload 'cvs-status-get-tags "cvs-status")
220(defun cvs-tags-list () 220(defun cvs-tags-list ()
221 "Return a list of acceptable tags, ready for completions." 221 "Return a list of acceptable tags, ready for completions."
222 (assert (cvs-buffer-p)) 222 (cl-assert (cvs-buffer-p))
223 (let ((marked (cvs-get-marked))) 223 (let ((marked (cvs-get-marked)))
224 (list* '("BASE") '("HEAD") 224 `(("BASE") ("HEAD")
225 (when marked 225 ,@(when marked
226 (with-temp-buffer 226 (with-temp-buffer
227 (process-file cvs-program 227 (process-file cvs-program
228 nil ;no input 228 nil ;no input
229 t ;output to current-buffer 229 t ;output to current-buffer
230 nil ;don't update display while running 230 nil ;don't update display while running
231 "status" 231 "status"
232 "-v" 232 "-v"
233 (cvs-fileinfo->full-name (car marked))) 233 (cvs-fileinfo->full-name (car marked)))
234 (goto-char (point-min)) 234 (goto-char (point-min))
235 (let ((tags (cvs-status-get-tags))) 235 (let ((tags (cvs-status-get-tags)))
236 (when (listp tags) tags))))))) 236 (when (listp tags) tags)))))))
237 237
238(defvar cvs-tag-history nil) 238(defvar cvs-tag-history nil)
239(defconst cvs-qtypedesc-tag 239(defconst cvs-qtypedesc-tag
@@ -426,16 +426,16 @@ If non-nil, NEW means to create a new buffer no matter what."
426 ;; look for another cvs buffer visiting the same directory 426 ;; look for another cvs buffer visiting the same directory
427 (save-excursion 427 (save-excursion
428 (unless new 428 (unless new
429 (dolist (buffer (cons (current-buffer) (buffer-list))) 429 (cl-dolist (buffer (cons (current-buffer) (buffer-list)))
430 (set-buffer buffer) 430 (set-buffer buffer)
431 (and (cvs-buffer-p) 431 (and (cvs-buffer-p)
432 (case cvs-reuse-cvs-buffer 432 (pcase cvs-reuse-cvs-buffer
433 (always t) 433 (`always t)
434 (subdir 434 (`subdir
435 (or (string-prefix-p default-directory dir) 435 (or (string-prefix-p default-directory dir)
436 (string-prefix-p dir default-directory))) 436 (string-prefix-p dir default-directory)))
437 (samedir (string= default-directory dir))) 437 (`samedir (string= default-directory dir)))
438 (return buffer))))) 438 (cl-return buffer)))))
439 ;; we really have to create a new buffer: 439 ;; we really have to create a new buffer:
440 ;; we temporarily bind cwd to "" to prevent 440 ;; we temporarily bind cwd to "" to prevent
441 ;; create-file-buffer from using directory info 441 ;; create-file-buffer from using directory info
@@ -478,7 +478,7 @@ If non-nil, NEW means to create a new buffer no matter what."
478 ;;(set-buffer buf) 478 ;;(set-buffer buf)
479 buffer)))))) 479 buffer))))))
480 480
481(defun* cvs-cmd-do (cmd dir flags fis new 481(cl-defun cvs-cmd-do (cmd dir flags fis new
482 &key cvsargs noexist dont-change-disc noshow) 482 &key cvsargs noexist dont-change-disc noshow)
483 (let* ((dir (file-name-as-directory 483 (let* ((dir (file-name-as-directory
484 (abbreviate-file-name (expand-file-name dir)))) 484 (abbreviate-file-name (expand-file-name dir))))
@@ -501,7 +501,7 @@ If non-nil, NEW means to create a new buffer no matter what."
501;; cvsbuf)))) 501;; cvsbuf))))
502 502
503(defun cvs-run-process (args fis postprocess &optional single-dir) 503(defun cvs-run-process (args fis postprocess &optional single-dir)
504 (assert (cvs-buffer-p cvs-buffer)) 504 (cl-assert (cvs-buffer-p cvs-buffer))
505 (save-current-buffer 505 (save-current-buffer
506 (let ((procbuf (current-buffer)) 506 (let ((procbuf (current-buffer))
507 (cvsbuf cvs-buffer) 507 (cvsbuf cvs-buffer)
@@ -521,9 +521,9 @@ If non-nil, NEW means to create a new buffer no matter what."
521 (let ((inhibit-read-only t)) 521 (let ((inhibit-read-only t))
522 (insert "pcl-cvs: descending directory " dir "\n")) 522 (insert "pcl-cvs: descending directory " dir "\n"))
523 ;; loop to find the same-dir-elems 523 ;; loop to find the same-dir-elems
524 (do* ((files () (cons (cvs-fileinfo->file fi) files)) 524 (cl-do* ((files () (cons (cvs-fileinfo->file fi) files))
525 (fis fis (cdr fis)) 525 (fis fis (cdr fis))
526 (fi (car fis) (car fis))) 526 (fi (car fis) (car fis)))
527 ((not (and fis (string= dir (cvs-fileinfo->dir fi)))) 527 ((not (and fis (string= dir (cvs-fileinfo->dir fi))))
528 (list dir files fis)))))) 528 (list dir files fis))))))
529 (dir (nth 0 dir+files+rest)) 529 (dir (nth 0 dir+files+rest))
@@ -813,7 +813,7 @@ TIN specifies an optional starting point."
813 (while (and tin (cvs-fileinfo< fi (ewoc-data tin))) 813 (while (and tin (cvs-fileinfo< fi (ewoc-data tin)))
814 (setq tin (ewoc-prev c tin))) 814 (setq tin (ewoc-prev c tin)))
815 (if (null tin) (ewoc-enter-first c fi) ;empty collection 815 (if (null tin) (ewoc-enter-first c fi) ;empty collection
816 (assert (not (cvs-fileinfo< fi (ewoc-data tin)))) 816 (cl-assert (not (cvs-fileinfo< fi (ewoc-data tin))))
817 (let ((next-tin (ewoc-next c tin))) 817 (let ((next-tin (ewoc-next c tin)))
818 (while (not (or (null next-tin) 818 (while (not (or (null next-tin)
819 (cvs-fileinfo< fi (ewoc-data next-tin)))) 819 (cvs-fileinfo< fi (ewoc-data next-tin))))
@@ -871,15 +871,15 @@ RM-MSGS if non-nil means remove messages."
871 (let* ((type (cvs-fileinfo->type fi)) 871 (let* ((type (cvs-fileinfo->type fi))
872 (subtype (cvs-fileinfo->subtype fi)) 872 (subtype (cvs-fileinfo->subtype fi))
873 (keep 873 (keep
874 (case type 874 (pcase type
875 ;; remove temp messages and keep the others 875 ;; remove temp messages and keep the others
876 (MESSAGE (not (or rm-msgs (eq subtype 'TEMP)))) 876 (`MESSAGE (not (or rm-msgs (eq subtype 'TEMP))))
877 ;; remove entries 877 ;; remove entries
878 (DEAD nil) 878 (`DEAD nil)
879 ;; handled also? 879 ;; handled also?
880 (UP-TO-DATE (not rm-handled)) 880 (`UP-TO-DATE (not rm-handled))
881 ;; keep the rest 881 ;; keep the rest
882 (t (not (run-hook-with-args-until-success 882 (_ (not (run-hook-with-args-until-success
883 'cvs-cleanup-functions fi)))))) 883 'cvs-cleanup-functions fi))))))
884 884
885 ;; mark dirs for removal 885 ;; mark dirs for removal
@@ -1389,7 +1389,7 @@ an empty list if it doesn't point to a file at all."
1389 fis)))) 1389 fis))))
1390 (nreverse fis))) 1390 (nreverse fis)))
1391 1391
1392(defun* cvs-mode-marked (filter &optional cmd 1392(cl-defun cvs-mode-marked (filter &optional cmd
1393 &key read-only one file noquery) 1393 &key read-only one file noquery)
1394 "Get the list of marked FIS. 1394 "Get the list of marked FIS.
1395CMD is used to determine whether to use the marks or not. 1395CMD 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,
1474 (let ((msg (buffer-substring-no-properties (point-min) (point-max)))) 1474 (let ((msg (buffer-substring-no-properties (point-min) (point-max))))
1475 (cvs-mode!) 1475 (cvs-mode!)
1476 ;;(pop-to-buffer cvs-buffer) 1476 ;;(pop-to-buffer cvs-buffer)
1477 (cvs-mode-do "commit" (list* "-m" msg flags) 'commit))) 1477 (cvs-mode-do "commit" `("-m" ,msg ,@flags) 'commit)))
1478 1478
1479 1479
1480;;;; Editing existing commit log messages. 1480;;;; Editing existing commit log messages.
@@ -1604,7 +1604,7 @@ With prefix argument, prompt for cvs flags."
1604 (or current-prefix-arg (not cvs-add-default-message))) 1604 (or current-prefix-arg (not cvs-add-default-message)))
1605 (read-from-minibuffer "Enter description: ") 1605 (read-from-minibuffer "Enter description: ")
1606 (or cvs-add-default-message ""))) 1606 (or cvs-add-default-message "")))
1607 (flags (list* "-m" msg flags)) 1607 (flags `("-m" ,msg ,@flags))
1608 (postproc 1608 (postproc
1609 ;; setup postprocessing for the directory entries 1609 ;; setup postprocessing for the directory entries
1610 (when dirs 1610 (when dirs
@@ -1845,7 +1845,7 @@ Signal an error if there is no backup file."
1845 (setq ret t))) 1845 (setq ret t)))
1846 ret))) 1846 ret)))
1847 1847
1848(defun* cvs-mode-run (cmd flags fis 1848(cl-defun cvs-mode-run (cmd flags fis
1849 &key (buf (cvs-temp-buffer)) 1849 &key (buf (cvs-temp-buffer))
1850 dont-change-disc cvsargs postproc) 1850 dont-change-disc cvsargs postproc)
1851 "Generic cvs-mode-<foo> function. 1851 "Generic cvs-mode-<foo> function.
@@ -1887,7 +1887,7 @@ POSTPROC is a list of expressions to be evaluated at the very end (after
1887 (cvs-run-process args fis postproc single-dir)))) 1887 (cvs-run-process args fis postproc single-dir))))
1888 1888
1889 1889
1890(defun* cvs-mode-do (cmd flags filter 1890(cl-defun cvs-mode-do (cmd flags filter
1891 &key show dont-change-disc cvsargs postproc) 1891 &key show dont-change-disc cvsargs postproc)
1892 "Generic cvs-mode-<foo> function. 1892 "Generic cvs-mode-<foo> function.
1893Executes `cvs CVSARGS CMD FLAGS' on the selected files. 1893Executes `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 @@
43 43
44;;; Code: 44;;; Code:
45 45
46(eval-when-compile (require 'cl)) 46(eval-when-compile (require 'cl-lib))
47(require 'diff-mode) ;For diff-auto-refine-mode. 47(require 'diff-mode) ;For diff-auto-refine-mode.
48(require 'newcomment) 48(require 'newcomment)
49 49
@@ -716,7 +716,7 @@ major modes. Uses `smerge-resolve-function' to do the actual work."
716 (while (or (not (match-end i)) 716 (while (or (not (match-end i))
717 (< (point) (match-beginning i)) 717 (< (point) (match-beginning i))
718 (>= (point) (match-end i))) 718 (>= (point) (match-end i)))
719 (decf i)) 719 (cl-decf i))
720 i)) 720 i))
721 721
722(defun smerge-keep-current () 722(defun smerge-keep-current ()
@@ -779,7 +779,7 @@ An error is raised if not inside a conflict."
779 (filename (or (match-string 1) "")) 779 (filename (or (match-string 1) ""))
780 780
781 (_ (re-search-forward smerge-end-re)) 781 (_ (re-search-forward smerge-end-re))
782 (_ (assert (< orig-point (match-end 0)))) 782 (_ (cl-assert (< orig-point (match-end 0))))
783 783
784 (other-end (match-beginning 0)) 784 (other-end (match-beginning 0))
785 (end (match-end 0)) 785 (end (match-end 0))
@@ -1073,12 +1073,12 @@ used to replace chars to try and eliminate some spurious differences."
1073 (forward-line 1) ;Skip hunk header. 1073 (forward-line 1) ;Skip hunk header.
1074 (and (re-search-forward "^[0-9]" nil 'move) ;Skip hunk body. 1074 (and (re-search-forward "^[0-9]" nil 'move) ;Skip hunk body.
1075 (goto-char (match-beginning 0)))) 1075 (goto-char (match-beginning 0))))
1076 ;; (assert (or (null last1) (< (overlay-start last1) end1))) 1076 ;; (cl-assert (or (null last1) (< (overlay-start last1) end1)))
1077 ;; (assert (or (null last2) (< (overlay-start last2) end2))) 1077 ;; (cl-assert (or (null last2) (< (overlay-start last2) end2)))
1078 (if smerge-refine-weight-hack 1078 (if smerge-refine-weight-hack
1079 (progn 1079 (progn
1080 ;; (assert (or (null last1) (<= (overlay-end last1) end1))) 1080 ;; (cl-assert (or (null last1) (<= (overlay-end last1) end1)))
1081 ;; (assert (or (null last2) (<= (overlay-end last2) end2))) 1081 ;; (cl-assert (or (null last2) (<= (overlay-end last2) end2)))
1082 ) 1082 )
1083 ;; smerge-refine-forward-function when calling in chopup may 1083 ;; smerge-refine-forward-function when calling in chopup may
1084 ;; have stopped because it bumped into EOB whereas in 1084 ;; have stopped because it bumped into EOB whereas in
@@ -1290,8 +1290,8 @@ with a \\[universal-argument] prefix, makes up a 3-way conflict."
1290 (progn (pop-mark) (mark)) 1290 (progn (pop-mark) (mark))
1291 (when current-prefix-arg (pop-mark) (mark)))) 1291 (when current-prefix-arg (pop-mark) (mark))))
1292 ;; Start from the end so as to avoid problems with pos-changes. 1292 ;; Start from the end so as to avoid problems with pos-changes.
1293 (destructuring-bind (pt1 pt2 pt3 &optional pt4) 1293 (pcase-let ((`(,pt1 ,pt2 ,pt3 ,pt4)
1294 (sort (list* pt1 pt2 pt3 (if pt4 (list pt4))) '>=) 1294 (sort `(,pt1 ,pt2 ,pt3 ,@(if pt4 (list pt4))) '>=)))
1295 (goto-char pt1) (beginning-of-line) 1295 (goto-char pt1) (beginning-of-line)
1296 (insert ">>>>>>> OTHER\n") 1296 (insert ">>>>>>> OTHER\n")
1297 (goto-char pt2) (beginning-of-line) 1297 (goto-char pt2) (beginning-of-line)
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-20 13:59:35 +0000