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.

diff --git a/admin/ChangeLog b/admin/ChangeLog
index 5ae49cd..6c5b134 100644 (file)
--- a/admin/ChangeLog
+++ b/admin/ChangeLog
@@ -1,3 +1,7 @@
+2012-07-10  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       * bzrmerge.el: Use cl-lib.
+

 2012-07-09  Paul Eggert  <eggert@cs.ucla.edu>
 
        Rename configure.in to configure.ac (Bug#11603).
 2012-07-09  Paul Eggert  <eggert@cs.ucla.edu>
 
        Rename configure.in to configure.ac (Bug#11603).


@@ -30,8 +34,8 @@
        * coccinelle: New subdirectory
        * coccinelle/README: Documentation stub.
        * coccinelle/vector_contents.cocci: Semantic patch to replace direct
        * coccinelle: New subdirectory
        * coccinelle/README: Documentation stub.
        * coccinelle/vector_contents.cocci: Semantic patch to replace direct

-        access to `contents' member of Lisp_Vector objects with AREF and ASET
-        where appropriate.
+       access to `contents' member of Lisp_Vector objects with AREF and ASET
+       where appropriate.

 
 2012-06-22  Paul Eggert  <eggert@cs.ucla.edu>
 
 
 2012-06-22  Paul Eggert  <eggert@cs.ucla.edu>
 


@@ -50,9 +54,9 @@
 
 2012-06-13  Andreas Schwab  <schwab@linux-m68k.org>
 
 
 2012-06-13  Andreas Schwab  <schwab@linux-m68k.org>
 

-       * make-emacs: Rename --union-type to --check-lisp-type.  Define
-       CHECK_LISP_OBJECT_TYPE insted of USE_LISP_UNION_TYPE.
-       * CPP-DEFINES (DEBUG_LISP_OBJECT_TYPE): Renamed from
+       * make-emacs: Rename --union-type to --check-lisp-type.
+       Define CHECK_LISP_OBJECT_TYPE insted of USE_LISP_UNION_TYPE.
+       * CPP-DEFINES (DEBUG_LISP_OBJECT_TYPE): Rename from

        USE_LISP_UNION_TYPE.
 
 2012-06-03  Glenn Morris  <rgm@gnu.org>
        USE_LISP_UNION_TYPE.
 
 2012-06-03  Glenn Morris  <rgm@gnu.org>


@@ -223,11 +227,11 @@
 
        * unidata/makefile.w32-in (all): Remove src/biditype.h and
        src/bidimirror.h.
 
        * unidata/makefile.w32-in (all): Remove src/biditype.h and
        src/bidimirror.h.

-       (../../src/biditype.h, ../../src/bidimirror.h): Deleted.
+       (../../src/biditype.h, ../../src/bidimirror.h): Delete.

 
        * unidata/Makefile.in (all): Remove src/biditype.h and
        src/bidimirror.h.
 
        * unidata/Makefile.in (all): Remove src/biditype.h and
        src/bidimirror.h.

-       (../../src/biditype.h, ../../src/bidimirror.h): Deleted.
+       (../../src/biditype.h, ../../src/bidimirror.h): Delete.

 
 2011-07-07  Juanma Barranquero  <lekktu@gmail.com>
 
 
 2011-07-07  Juanma Barranquero  <lekktu@gmail.com>
 


@@ -238,8 +242,8 @@
 
        * unidata/unidata-gen.el (unidata-dir): New variable.
        (unidata-setup-list): Expand unidata-text-file in unidata-dir.
 
        * unidata/unidata-gen.el (unidata-dir): New variable.
        (unidata-setup-list): Expand unidata-text-file in unidata-dir.

-       (unidata-prop-alist): INDEX element may be a function.  New
-       optional element VAL-LIST (for general-category and bidi-class).
+       (unidata-prop-alist): INDEX element may be a function.
+       New optional element VAL-LIST (for general-category and bidi-class).

        New entry `mirroring'.
        (unidata-prop-default, unidata-prop-val-list): New subst.
        (unidata-get-character, unidata-put-character): Delete them.
        New entry `mirroring'.
        (unidata-prop-default, unidata-prop-val-list): New subst.
        (unidata-get-character, unidata-put-character): Delete them.


@@ -595,13 +599,13 @@
 
 2009-04-17  Kenichi Handa  <handa@m17n.org>
 
 
 2009-04-17  Kenichi Handa  <handa@m17n.org>
 

-       * unidata/unidata-gen.el (unidata-get-decomposition): Adjust
-       Hangle decomposition rule to Unicode.
+       * unidata/unidata-gen.el (unidata-get-decomposition):
+       Adjust Hangle decomposition rule to Unicode.

 
 2009-04-09  Kenichi Handa  <handa@m17n.org>
 
 
 2009-04-09  Kenichi Handa  <handa@m17n.org>
 

-       * unidata/unidata-gen.el (unidata-describe-decomposition): Return
-       a string with a composition property to disable combining
+       * unidata/unidata-gen.el (unidata-describe-decomposition):
+       Return a string with a composition property to disable combining

        characters being composed.
 
 2009-03-11  Miles Bader  <miles@gnu.org>
        characters being composed.
 
 2009-03-11  Miles Bader  <miles@gnu.org>


@@ -1096,7 +1100,7 @@
 
 2005-10-17  Bill Wohler  <wohler@newt.com>
 
 
 2005-10-17  Bill Wohler  <wohler@newt.com>
 

-       * FOR-RELEASE (DOCUMENTATION): Removed lisp/toolbar from list
+       * FOR-RELEASE (DOCUMENTATION): Remove lisp/toolbar from list

        since it's gone.  Also marked mh-e as done.
 
 2005-10-11  Juanma Barranquero  <lekktu@gmail.com>
        since it's gone.  Also marked mh-e as done.
 
 2005-10-11  Juanma Barranquero  <lekktu@gmail.com>


@@ -1143,7 +1147,7 @@
 
 2005-03-30  Marcelo Toledo  <marcelo@marcelotoledo.org>
 
 
 2005-03-30  Marcelo Toledo  <marcelo@marcelotoledo.org>
 

-       * FOR-RELEASE (Documentation): Added check the Emacs Tutorial.
+       * FOR-RELEASE (Documentation): Add check the Emacs Tutorial.

        The first line of every tutorial must begin with a sentence saying
        "Emacs Tutorial" in the respective language.  This should be
        followed by "See end for copying conditions", likewise in the
        The first line of every tutorial must begin with a sentence saying
        "Emacs Tutorial" in the respective language.  This should be
        followed by "See end for copying conditions", likewise in the

diff --git a/admin/bzrmerge.el b/admin/bzrmerge.el
index 15238f4..4f5cee1 100644 (file)
--- a/admin/bzrmerge.el
+++ b/admin/bzrmerge.el
@@ -24,8 +24,7 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile
-  (require 'cl))                        ; assert
+(eval-when-compile (require 'cl-lib))

 
 (defvar bzrmerge-skip-regexp
   "back[- ]?port\\|merge\\|sync\\|re-?generate\\|bump version\\|from trunk\\|\
 
 (defvar bzrmerge-skip-regexp
   "back[- ]?port\\|merge\\|sync\\|re-?generate\\|bump version\\|from trunk\\|\


@@ -256,17 +255,17 @@ Does not make other difference."
           ;; Do a "skip" (i.e. merge the meta-data only).
           (setq beg (1- (car skip)))
           (while (and skip (or (null merge) (< (car skip) (car merge))))
           ;; Do a "skip" (i.e. merge the meta-data only).
           (setq beg (1- (car skip)))
           (while (and skip (or (null merge) (< (car skip) (car merge))))

-            (assert (> (car skip) (or end beg)))
+            (cl-assert (> (car skip) (or end beg)))

             (setq end (pop skip)))
           (message "Skipping %s..%s" beg end)
           (bzrmerge-add-metadata from end))
 
          (t
           ;; Do a "normal" merge.
             (setq end (pop skip)))
           (message "Skipping %s..%s" beg end)
           (bzrmerge-add-metadata from end))
 
          (t
           ;; Do a "normal" merge.

-          (assert (or (null skip) (< (car merge) (car skip))))
+          (cl-assert (or (null skip) (< (car merge) (car skip))))

           (setq beg (1- (car merge)))
           (while (and merge (or (null skip) (< (car merge) (car skip))))
           (setq beg (1- (car merge)))
           (while (and merge (or (null skip) (< (car merge) (car skip))))

-            (assert (> (car merge) (or end beg)))
+            (cl-assert (> (car merge) (or end beg)))

             (setq end (pop merge)))
           (message "Merging %s..%s" beg end)
           (if (with-temp-buffer
             (setq end (pop merge)))
           (message "Merging %s..%s" beg end)
           (if (with-temp-buffer

diff --git a/leim/ChangeLog b/leim/ChangeLog
index 3452322..f3acaeb 100644 (file)
--- a/leim/ChangeLog
+++ b/leim/ChangeLog
@@ -1,3 +1,9 @@
+2012-07-10  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       * quail/ipa.el: Use cl-lib.
+
+       * quail/hangul.el: Don't require CL.
+

 2012-06-12  Nguyen Thai Ngoc Duy  <pclouds@gmail.com>
 
        * quail/vnvi.el: New file (Bug#4747).
 2012-06-12  Nguyen Thai Ngoc Duy  <pclouds@gmail.com>
 
        * quail/vnvi.el: New file (Bug#4747).

diff --git a/leim/quail/hangul.el b/leim/quail/hangul.el
index 2ce55a5..d30957a 100644 (file)
--- a/leim/quail/hangul.el
+++ b/leim/quail/hangul.el
@@ -30,7 +30,6 @@
 ;;; Code:
 
 (require 'quail)
 ;;; Code:
 
 (require 'quail)

-(eval-when-compile (require 'cl))       ; for setf

 (require 'hanja-util)
 
 ;; Hangul double Jamo table.
 (require 'hanja-util)
 
 ;; Hangul double Jamo table.

diff --git a/leim/quail/ipa.el b/leim/quail/ipa.el
index 72db819..b29a6ff 100644 (file)
--- a/leim/quail/ipa.el
+++ b/leim/quail/ipa.el
@@ -29,7 +29,7 @@
 ;;; Code:
 
 (require 'quail)
 ;;; Code:
 
 (require 'quail)

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))

 
 (quail-define-package
  "ipa" "IPA" "IPA" t
 
 (quail-define-package
  "ipa" "IPA" "IPA" t


@@ -277,13 +277,13 @@ string."
       (setq quail-keymap (list (string quail-keymap)))
     (if (stringp quail-keymap)
        (setq quail-keymap (list quail-keymap))
       (setq quail-keymap (list (string quail-keymap)))
     (if (stringp quail-keymap)
        (setq quail-keymap (list quail-keymap))

-      (assert (vectorp quail-keymap) t)
+      (cl-assert (vectorp quail-keymap) t)

       (setq quail-keymap (append quail-keymap nil))))
   (list
    (apply 'vector
          (mapcar
           #'(lambda (entry)
       (setq quail-keymap (append quail-keymap nil))))
   (list
    (apply 'vector
          (mapcar
           #'(lambda (entry)

-               (assert (char-or-string-p entry) t)
+               (cl-assert (char-or-string-p entry) t)

                (format "%s%s" to-prepend
                        (if (integerp entry) (string entry) entry)))
           quail-keymap))))
                (format "%s%s" to-prepend
                        (if (integerp entry) (string entry) entry)))
           quail-keymap))))


@@ -318,18 +318,18 @@ particular sequence of keys, and the result will be cached by Quail."
     (dolist (underscoring underscore-map)
       (cond ((null underscoring))
            ((eq (length underscoring) 2)
     (dolist (underscoring underscore-map)
       (cond ((null underscoring))
            ((eq (length underscoring) 2)

-            (setq underscore-map-entry (second underscoring))
+            (setq underscore-map-entry (cl-second underscoring))

             (setcdr underscoring (ipa-x-sampa-prepend-to-keymap-entry
                                   pre-underscore-map underscore-map-entry)))
            ((eq (length underscoring) 3)
             (setcdr underscoring (ipa-x-sampa-prepend-to-keymap-entry
                                   pre-underscore-map underscore-map-entry)))
            ((eq (length underscoring) 3)

-            (setq underscore-map-entry (second (third underscoring)))
-            (setcdr (third underscoring)
+            (setq underscore-map-entry (cl-second (cl-third underscoring)))
+            (setcdr (cl-third underscoring)

                     (ipa-x-sampa-prepend-to-keymap-entry
                      pre-underscore-map underscore-map-entry)))
            (t
                     (ipa-x-sampa-prepend-to-keymap-entry
                      pre-underscore-map underscore-map-entry)))
            (t

-            (assert (null t) t
-                    "Can't handle subtrees of this level right now."))))
-    (append underscore-map (list (list ?< (second x-sampa-submap-entry))))))
+            (cl-assert (null t) t
+                        "Can't handle subtrees of this level right now."))))
+    (append underscore-map (list (list ?< (cl-second x-sampa-submap-entry))))))

 
 (quail-define-package
  "ipa-x-sampa" "IPA" "IPA-X" t
 
 (quail-define-package
  "ipa-x-sampa" "IPA" "IPA-X" t

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index a441bd0..a820486 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,25 @@
 2012-07-10  Stefan Monnier  <monnier@iro.umontreal.ca>
 
 2012-07-10  Stefan Monnier  <monnier@iro.umontreal.ca>
 

+       Reduce use of (require 'cl).
+       * 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-lisp/bytecomp.el (byte-recompile-directory, display-call-tree)
+       (byte-compile-unfold-bcf, byte-compile-check-variable):
+       * emacs-lisp/byte-opt.el (byte-compile-trueconstp)
+       (byte-compile-nilconstp):
+       * emacs-lisp/autoload.el (make-autoload): Use pcase.
+       * face-remap.el (text-scale-adjust): Simplify pcase patterns.
+

        * emacs-lisp/gv.el (cond): Make it a valid place.
        (if): Simplify slightly.
 
        * emacs-lisp/gv.el (cond): Make it a valid place.
        (if): Simplify slightly.
 

diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index 9b82b3b..114afd8 100644 (file)
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -31,7 +31,7 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))

 
 (defgroup abbrev-mode nil
   "Word abbreviations mode."
 
 (defgroup abbrev-mode nil
   "Word abbreviations mode."


@@ -540,7 +540,7 @@ the current abbrev table before abbrev lookup happens."
     (dotimes (i (length table))
       (aset table i 0))
     ;; Preserve the table's properties.
     (dotimes (i (length table))
       (aset table i 0))
     ;; Preserve the table's properties.

-    (assert sym)
+    (cl-assert sym)

     (let ((newsym (intern "" table)))
       (set newsym nil)      ; Make sure it won't be confused for an abbrev.
       (setplist newsym (symbol-plist sym)))
     (let ((newsym (intern "" table)))
       (set newsym nil)      ; Make sure it won't be confused for an abbrev.
       (setplist newsym (symbol-plist sym)))


@@ -583,8 +583,8 @@ An obsolete but still supported calling form is:
 \(define-abbrev TABLE NAME EXPANSION &optional HOOK COUNT SYSTEM)."
   (when (and (consp props) (or (null (car props)) (numberp (car props))))
     ;; Old-style calling convention.
 \(define-abbrev TABLE NAME EXPANSION &optional HOOK COUNT SYSTEM)."
   (when (and (consp props) (or (null (car props)) (numberp (car props))))
     ;; Old-style calling convention.

-    (setq props (list* :count (car props)
-                       (if (cadr props) (list :system (cadr props))))))
+    (setq props `(:count ,(car props)
+                  ,@(if (cadr props) (list :system (cadr props))))))

   (unless (plist-get props :count)
     (setq props (plist-put props :count 0)))
   (let ((system-flag (plist-get props :system))
   (unless (plist-get props :count)
     (setq props (plist-put props :count 0)))
   (let ((system-flag (plist-get props :system))


@@ -621,7 +621,7 @@ current (if global is nil) or standard syntax table."
       (let ((badchars ())
             (pos 0))
         (while (string-match "\\W" abbrev pos)
       (let ((badchars ())
             (pos 0))
         (while (string-match "\\W" abbrev pos)

-          (pushnew (aref abbrev (match-beginning 0)) badchars)
+          (cl-pushnew (aref abbrev (match-beginning 0)) badchars)

           (setq pos (1+ pos)))
         (error "Some abbrev characters (%s) are not word constituents %s"
                (apply 'string (nreverse badchars))
           (setq pos (1+ pos)))
         (error "Some abbrev characters (%s) are not word constituents %s"
                (apply 'string (nreverse badchars))


@@ -836,8 +836,7 @@ return value is that of `abbrev-insert'.)"
   (interactive)
   (run-hooks 'pre-abbrev-expand-hook)
   (with-wrapper-hook abbrev-expand-functions ()
   (interactive)
   (run-hooks 'pre-abbrev-expand-hook)
   (with-wrapper-hook abbrev-expand-functions ()

-    (destructuring-bind (&optional sym name wordstart wordend)
-        (abbrev--before-point)
+    (pcase-let ((`(,sym ,name ,wordstart ,wordend) (abbrev--before-point)))

       (when sym
         (let ((startpos (copy-marker (point) t))
               (endmark (copy-marker wordend t)))
       (when sym
         (let ((startpos (copy-marker (point) t))
               (endmark (copy-marker wordend t)))

diff --git a/lisp/apropos.el b/lisp/apropos.el
index f5373b3..e1c3e06 100644 (file)
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -36,12 +36,12 @@
 ;; Fixed bug, current-local-map can return nil.
 ;; Change, doesn't calculate key-bindings unless needed.
 ;; Added super-apropos capability, changed print functions.
 ;; Fixed bug, current-local-map can return nil.
 ;; Change, doesn't calculate key-bindings unless needed.
 ;; Added super-apropos capability, changed print functions.

-;;; Made fast-apropos and super-apropos share code.
-;;; Sped up fast-apropos again.
+;; Made fast-apropos and super-apropos share code.
+;; Sped up fast-apropos again.

 ;; Added apropos-do-all option.
 ;; Added apropos-do-all option.

-;;; Added fast-command-apropos.
+;; Added fast-command-apropos.

 ;; Changed doc strings to comments for helping functions.
 ;; Changed doc strings to comments for helping functions.

-;;; Made doc file buffer read-only, buried it.
+;; Made doc file buffer read-only, buried it.

 ;; Only call substitute-command-keys if do-all set.
 
 ;; Optionally use configurable faces to make the output more legible.
 ;; Only call substitute-command-keys if do-all set.
 
 ;; Optionally use configurable faces to make the output more legible.


@@ -57,7 +57,6 @@
 ;;; Code:
 
 (require 'button)
 ;;; Code:
 
 (require 'button)

-(eval-when-compile (require 'cl))

 
 (defgroup apropos nil
   "Apropos commands for users and programmers."
 
 (defgroup apropos nil
   "Apropos commands for users and programmers."


@@ -640,11 +639,11 @@ the output includes key-bindings of commands."
             (setq lh (cdr lh)))))
       (unless lh-entry (error "Unknown library `%s'" file)))
     (dolist (x (cdr lh-entry))
             (setq lh (cdr lh)))))
       (unless lh-entry (error "Unknown library `%s'" file)))
     (dolist (x (cdr lh-entry))

-      (case (car-safe x)
+      (pcase (car-safe x)

        ;; (autoload (push (cdr x) autoloads))
        ;; (autoload (push (cdr x) autoloads))

-       (require (push (cdr x) requires))
-       (provide (push (cdr x) provides))
-       (t (push (or (cdr-safe x) x) symbols))))
+       (`require (push (cdr x) requires))
+       (`provide (push (cdr x) provides))
+       (_ (push (or (cdr-safe x) x) symbols))))

     (let ((apropos-pattern "")) ;Dummy binding for apropos-symbols-internal.
       (apropos-symbols-internal
        symbols apropos-do-all
     (let ((apropos-pattern "")) ;Dummy binding for apropos-symbols-internal.
       (apropos-symbols-internal
        symbols apropos-do-all

diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index 11005f4..0f082d2 100644 (file)
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -94,9 +94,6 @@
 
 (require 'timer)
 
 
 (require 'timer)
 

-(eval-when-compile (require 'cl))
-
-

 ;; Custom Group:
 ;;
 ;; The two modes will be placed next to Auto Save Mode under the
 ;; Custom Group:
 ;;
 ;; The two modes will be placed next to Auto Save Mode under the

diff --git a/lisp/avoid.el b/lisp/avoid.el
index bfe15de..2fa6ef3 100644 (file)
--- a/lisp/avoid.el
+++ b/lisp/avoid.el
@@ -67,7 +67,7 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))

 
 (defgroup avoid nil
   "Make mouse pointer stay out of the way of editing."
 
 (defgroup avoid nil
   "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
   (let* ((fra-or-win         (assoc-default
                               'frame-or-window
                               mouse-avoidance-banish-position 'eq))
   (let* ((fra-or-win         (assoc-default
                               'frame-or-window
                               mouse-avoidance-banish-position 'eq))

-         (list-values        (case fra-or-win
-                               (frame (list 0 0 (frame-width) (frame-height)))
-                               (window (window-edges))))
-         (alist              (loop for v in list-values
-                                   for k in '(left top right bottom)
-                                   collect (cons k v)))
+         (list-values        (pcase fra-or-win
+                               (`frame (list 0 0 (frame-width) (frame-height)))
+                               (`window (window-edges))))
+         (alist              (cl-loop for v in list-values
+                                      for k in '(left top right bottom)
+                                      collect (cons k v)))

          (side               (assoc-default
                               'side
          (side               (assoc-default
                               'side

-                              mouse-avoidance-banish-position 'eq))
+                              mouse-avoidance-banish-position #'eq))

          (side-dist          (assoc-default
                               'side-pos
          (side-dist          (assoc-default
                               'side-pos

-                              mouse-avoidance-banish-position 'eq))
+                              mouse-avoidance-banish-position #'eq))

          (top-or-bottom      (assoc-default
                               'top-or-bottom
          (top-or-bottom      (assoc-default
                               'top-or-bottom

-                              mouse-avoidance-banish-position 'eq))
+                              mouse-avoidance-banish-position #'eq))

          (top-or-bottom-dist (assoc-default
                               'top-or-bottom-pos
          (top-or-bottom-dist (assoc-default
                               'top-or-bottom-pos

-                              mouse-avoidance-banish-position 'eq))
-         (side-fn            (case side
-                               (left '+)
-                               (right '-)))
-         (top-or-bottom-fn   (case top-or-bottom
-                               (top '+)
-                               (bottom '-))))
+                              mouse-avoidance-banish-position #'eq))
+         (side-fn            (pcase side
+                               (`left '+)
+                               (`right '-)))
+         (top-or-bottom-fn   (pcase top-or-bottom
+                               (`top '+)
+                               (`bottom '-))))

     (cons (funcall side-fn                        ; -/+
                    (assoc-default side alist 'eq) ; right or left
                    side-dist)                     ; distance from side
     (cons (funcall side-fn                        ; -/+
                    (assoc-default side alist 'eq) ; right or left
                    side-dist)                     ; distance from side

diff --git a/lisp/battery.el b/lisp/battery.el
index dcfe071..8e98291 100644 (file)
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -31,8 +31,7 @@
 ;;; Code:
 
 (require 'timer)
 ;;; Code:
 
 (require 'timer)

-(eval-when-compile (require 'cl))
-
+(eval-when-compile (require 'cl-lib))

 \f
 (defgroup battery nil
   "Display battery status information."
 \f
 (defgroup battery nil
   "Display battery status information."


@@ -360,16 +359,16 @@ The following %-sequences are provided:
        (when (re-search-forward "present: +yes$" nil t)
          (when (re-search-forward "design capacity: +\\([0-9]+\\) m[AW]h$"
                                   nil t)
        (when (re-search-forward "present: +yes$" nil t)
          (when (re-search-forward "design capacity: +\\([0-9]+\\) m[AW]h$"
                                   nil t)

-           (incf design-capacity (string-to-number (match-string 1))))
+           (cl-incf design-capacity (string-to-number (match-string 1))))

          (when (re-search-forward "last full capacity: +\\([0-9]+\\) m[AW]h$"
                                   nil t)
          (when (re-search-forward "last full capacity: +\\([0-9]+\\) m[AW]h$"
                                   nil t)

-           (incf last-full-capacity (string-to-number (match-string 1))))
+           (cl-incf last-full-capacity (string-to-number (match-string 1))))

          (when (re-search-forward
                 "design capacity warning: +\\([0-9]+\\) m[AW]h$" nil t)
          (when (re-search-forward
                 "design capacity warning: +\\([0-9]+\\) m[AW]h$" nil t)

-           (incf warn (string-to-number (match-string 1))))
+           (cl-incf warn (string-to-number (match-string 1))))

          (when (re-search-forward "design capacity low: +\\([0-9]+\\) m[AW]h$"
                                   nil t)
          (when (re-search-forward "design capacity low: +\\([0-9]+\\) m[AW]h$"
                                   nil t)

-           (incf low (string-to-number (match-string 1)))))))
+           (cl-incf low (string-to-number (match-string 1)))))))

     (setq full-capacity (if (> last-full-capacity 0)
                            last-full-capacity design-capacity))
     (and capacity rate
     (setq full-capacity (if (> last-full-capacity 0)
                            last-full-capacity design-capacity))
     (and capacity rate

diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index bf2ea9a..8e6fb94 100644 (file)
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -33,7 +33,7 @@
 ;;; Code:
 
 (require 'pp)
 ;;; Code:
 
 (require 'pp)

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))

 
 ;;; Misc comments:
 ;;
 
 ;;; Misc comments:
 ;;


@@ -2015,11 +2015,11 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\
         (tmp-list     ()))
     (while
         (let ((char (read-key (concat prompt bookmark-search-pattern))))
         (tmp-list     ()))
     (while
         (let ((char (read-key (concat prompt bookmark-search-pattern))))

-          (case char
-            ((?\e ?\r) nil) ; RET or ESC break the search loop.
+          (pcase char
+            ((or ?\e ?\r) nil) ; RET or ESC break the search loop.

             (?\C-g (setq bookmark-quit-flag t) nil)
             (?\d (pop tmp-list) t) ; Delete last char of pattern with DEL
             (?\C-g (setq bookmark-quit-flag t) nil)
             (?\d (pop tmp-list) t) ; Delete last char of pattern with DEL

-            (t
+            (_

              (if (characterp char)
                  (push char tmp-list)
                (setq unread-command-events
              (if (characterp char)
                  (push char tmp-list)
                (setq unread-command-events


@@ -2034,9 +2034,9 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\
 (defun bookmark-bmenu-filter-alist-by-regexp (regexp)
   "Filter `bookmark-alist' with bookmarks matching REGEXP and rebuild list."
   (let ((bookmark-alist
 (defun bookmark-bmenu-filter-alist-by-regexp (regexp)
   "Filter `bookmark-alist' with bookmarks matching REGEXP and rebuild list."
   (let ((bookmark-alist

-         (loop for i in bookmark-alist
-               when (string-match regexp (car i)) collect i into new
-               finally return new)))
+         (cl-loop for i in bookmark-alist
+                  when (string-match regexp (car i)) collect i into new
+                  finally return new)))

     (bookmark-bmenu-list)))
 
 
     (bookmark-bmenu-list)))
 
 

diff --git a/lisp/bs.el b/lisp/bs.el
index 08d05a9..09aefee 100644 (file)
--- a/lisp/bs.el
+++ b/lisp/bs.el
@@ -124,8 +124,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
-

 ;; ----------------------------------------------------------------------
 ;; Globals for customization
 ;; ----------------------------------------------------------------------
 ;; ----------------------------------------------------------------------
 ;; Globals for customization
 ;; ----------------------------------------------------------------------


@@ -830,10 +828,10 @@ See `visit-tags-table'."
   (interactive)
   (let ((res
          (with-current-buffer (bs--current-buffer)
   (interactive)
   (let ((res
          (with-current-buffer (bs--current-buffer)

-           (setq bs-buffer-show-mark (case bs-buffer-show-mark
-                                       ((nil)   'never)
-                                       ((never) 'always)
-                                       (t       nil))))))
+           (setq bs-buffer-show-mark (pcase bs-buffer-show-mark
+                                       (`nil   'never)
+                                       (`never 'always)
+                                       (_       nil))))))

     (bs--update-current-line)
     (bs--set-window-height)
     (bs--show-config-message res)))
     (bs--update-current-line)
     (bs--set-window-height)
     (bs--show-config-message res)))

diff --git a/lisp/calculator.el b/lisp/calculator.el
index 14f50a0..b1a3f9e 100644 (file)
--- a/lisp/calculator.el
+++ b/lisp/calculator.el
@@ -43,8 +43,6 @@
 ;;; History:
 ;; I hate history.
 
 ;;; History:
 ;; I hate history.
 

-(eval-when-compile (require 'cl))
-

 ;;;=====================================================================
 ;;; Customization:
 
 ;;;=====================================================================
 ;;; Customization:
 

diff --git a/lisp/comint.el b/lisp/comint.el
index 4ccbfb5..431d05b 100644 (file)
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -101,7 +101,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))

 (require 'ring)
 (require 'ansi-color)
 (require 'regexp-opt)                   ;For regexp-opt-charset.
 (require 'ring)
 (require 'ansi-color)
 (require 'regexp-opt)                   ;For regexp-opt-charset.

diff --git a/lisp/composite.el b/lisp/composite.el
index 72317ac..4832848 100644 (file)
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -29,8 +29,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
-

 (defconst reference-point-alist
   '((tl . 0) (tc . 1) (tr . 2)
     (Bl . 3) (Bc . 4) (Br . 5)
 (defconst reference-point-alist
   '((tl . 0) (tc . 1) (tr . 2)
     (Bl . 3) (Bc . 4) (Br . 5)

diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el
index cd946bd..bfe3ae3 100644 (file)
--- a/lisp/cus-dep.el
+++ b/lisp/cus-dep.el
@@ -25,7 +25,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))

 (require 'widget)
 (require 'cus-face)
 
 (require 'widget)
 (require 'cus-face)
 

diff --git a/lisp/dired.el b/lisp/dired.el
index 68e1e57..18480ac 100644 (file)
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -34,8 +34,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
-

 ;;; Customizable variables
 
 (defgroup dired nil
 ;;; Customizable variables
 
 (defgroup dired nil

diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index f526825..72b36fe 100644 (file)
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -133,7 +133,7 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))

 (require 'dired)
 (require 'image-mode)
 (require 'jka-compr)
 (require 'dired)
 (require 'image-mode)
 (require 'jka-compr)


@@ -259,9 +259,9 @@ of the page moves to the previous page."
       (setq ol nil))
     (if ol
         (progn
       (setq ol nil))
     (if ol
         (progn

-          (assert (eq (overlay-buffer ol) (current-buffer)))
+          (cl-assert (eq (overlay-buffer ol) (current-buffer)))

           (setq ol (copy-overlay ol)))
           (setq ol (copy-overlay ol)))

-      (assert (not (get-char-property (point-min) 'display)))
+      (cl-assert (not (get-char-property (point-min) 'display)))

       (setq ol (make-overlay (point-min) (point-max) nil t))
       (overlay-put ol 'doc-view t))
     (overlay-put ol 'window (car winprops))
       (setq ol (make-overlay (point-min) (point-max) nil t))
       (overlay-put ol 'doc-view t))
     (overlay-put ol 'window (car winprops))


@@ -892,30 +892,30 @@ Start by converting PAGES, and then the rest."
 (defun doc-view-doc->txt (txt callback)
   "Convert the current document to text and call CALLBACK when done."
   (make-directory (doc-view-current-cache-dir) t)
 (defun doc-view-doc->txt (txt callback)
   "Convert the current document to text and call CALLBACK when done."
   (make-directory (doc-view-current-cache-dir) t)

-  (case doc-view-doc-type
-    (pdf
+  (pcase doc-view-doc-type
+    (`pdf

      ;; Doc is a PDF, so convert it to TXT
      (doc-view-pdf->txt doc-view-buffer-file-name txt callback))
      ;; Doc is a PDF, so convert it to TXT
      (doc-view-pdf->txt doc-view-buffer-file-name txt callback))

-    (ps
+    (`ps

      ;; Doc is a PS, so convert it to PDF (which will be converted to
      ;; TXT thereafter).
      (let ((pdf (expand-file-name "doc.pdf"
                                  (doc-view-current-cache-dir))))
        (doc-view-ps->pdf doc-view-buffer-file-name pdf
                          (lambda () (doc-view-pdf->txt pdf txt callback)))))
      ;; Doc is a PS, so convert it to PDF (which will be converted to
      ;; TXT thereafter).
      (let ((pdf (expand-file-name "doc.pdf"
                                  (doc-view-current-cache-dir))))
        (doc-view-ps->pdf doc-view-buffer-file-name pdf
                          (lambda () (doc-view-pdf->txt pdf txt callback)))))

-    (dvi
+    (`dvi

      ;; Doc is a DVI.  This means that a doc.pdf already exists in its
      ;; cache subdirectory.
      (doc-view-pdf->txt (expand-file-name "doc.pdf"
                                           (doc-view-current-cache-dir))
                         txt callback))
      ;; Doc is a DVI.  This means that a doc.pdf already exists in its
      ;; cache subdirectory.
      (doc-view-pdf->txt (expand-file-name "doc.pdf"
                                           (doc-view-current-cache-dir))
                         txt callback))

-    (odf
+    (`odf

      ;; Doc is some ODF (or MS Office) doc.  This means that a doc.pdf
      ;; already exists in its cache subdirectory.
      (doc-view-pdf->txt (expand-file-name "doc.pdf"
                                           (doc-view-current-cache-dir))
                         txt callback))
      ;; Doc is some ODF (or MS Office) doc.  This means that a doc.pdf
      ;; already exists in its cache subdirectory.
      (doc-view-pdf->txt (expand-file-name "doc.pdf"
                                           (doc-view-current-cache-dir))
                         txt callback))

-    (t (error "DocView doesn't know what to do"))))
+    (_ (error "DocView doesn't know what to do"))))

 
 (defun doc-view-ps->pdf (ps pdf callback)
   "Convert PS to PDF asynchronously and call CALLBACK when finished."
 
 (defun doc-view-ps->pdf (ps pdf callback)
   "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
   (let ((png-file (expand-file-name "page-%d.png"
                                     (doc-view-current-cache-dir))))
     (make-directory (doc-view-current-cache-dir) t)
   (let ((png-file (expand-file-name "page-%d.png"
                                     (doc-view-current-cache-dir))))
     (make-directory (doc-view-current-cache-dir) t)

-    (case doc-view-doc-type
-      (dvi
+    (pcase doc-view-doc-type
+      (`dvi

        ;; DVI files have to be converted to PDF before Ghostscript can process
        ;; it.
        (let ((pdf (expand-file-name "doc.pdf" doc-view-current-cache-dir)))
          (doc-view-dvi->pdf doc-view-buffer-file-name pdf
                             (lambda () (doc-view-pdf/ps->png pdf png-file)))))
        ;; DVI files have to be converted to PDF before Ghostscript can process
        ;; it.
        (let ((pdf (expand-file-name "doc.pdf" doc-view-current-cache-dir)))
          (doc-view-dvi->pdf doc-view-buffer-file-name pdf
                             (lambda () (doc-view-pdf/ps->png pdf png-file)))))

-      (odf
+      (`odf

        ;; ODF files have to be converted to PDF before Ghostscript can
        ;; process it.
        (let ((pdf (expand-file-name "doc.pdf" doc-view-current-cache-dir))
        ;; ODF files have to be converted to PDF before Ghostscript can
        ;; process it.
        (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
                              ;; Rename to doc.pdf
                              (rename-file opdf pdf)
                              (doc-view-pdf/ps->png pdf png-file)))))
                              ;; Rename to doc.pdf
                              (rename-file opdf pdf)
                              (doc-view-pdf/ps->png pdf png-file)))))

-      (pdf
+      (`pdf

        (let ((pages (doc-view-active-pages)))
          ;; Convert PDF to PNG images starting with the active pages.
          (doc-view-pdf->png doc-view-buffer-file-name png-file pages)))
        (let ((pages (doc-view-active-pages)))
          ;; Convert PDF to PNG images starting with the active pages.
          (doc-view-pdf->png doc-view-buffer-file-name png-file pages)))

-      (t
+      (_

        ;; Convert to PNG images.
        (doc-view-pdf/ps->png doc-view-buffer-file-name png-file)))))
 
        ;; Convert to PNG images.
        (doc-view-pdf/ps->png doc-view-buffer-file-name png-file)))))
 


@@ -1103,7 +1103,7 @@ have the page we want to view."
                    (and (not (member pagefile prev-pages))
                         (member pagefile doc-view-current-files)))
            (with-selected-window win
                    (and (not (member pagefile prev-pages))
                         (member pagefile doc-view-current-files)))
            (with-selected-window win

-                                 (assert (eq (current-buffer) buffer))
+                                 (cl-assert (eq (current-buffer) buffer))

                                  (doc-view-goto-page page))))))))
 
 (defun doc-view-buffer-message ()
                                  (doc-view-goto-page page))))))))
 
 (defun doc-view-buffer-message ()

diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 4bc7f6a..b1a24bc 100644 (file)
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -63,8 +63,7 @@
 
 ;;; Code:
 \f
 
 ;;; Code:
 \f

-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))

 
 (require 'kmacro)
 
 
 (require 'kmacro)
 


@@ -319,17 +318,18 @@ or nil, use a compact 80-column format."
                        mac))))
            (if no-keys
                (when cmd
                        mac))))
            (if no-keys
                (when cmd

-                 (loop for key in (where-is-internal cmd '(keymap)) do
-                       (global-unset-key key)))
+                 (cl-loop for key in (where-is-internal cmd '(keymap)) do
+                           (global-unset-key key)))

              (when keys
                (if (= (length mac) 0)
              (when keys
                (if (= (length mac) 0)

-                   (loop for key in keys do (global-unset-key key))
-                 (loop for key in keys do
-                       (global-set-key key
-                                       (or cmd
-                                           (if (and mac-counter mac-format)
-                                               (kmacro-lambda-form mac mac-counter mac-format)
-                                             mac))))))))))
+                   (cl-loop for key in keys do (global-unset-key key))
+                 (cl-loop for key in keys do
+                           (global-set-key key
+                                           (or cmd
+                                               (if (and mac-counter mac-format)
+                                                   (kmacro-lambda-form
+                                                    mac mac-counter mac-format)
+                                                 mac))))))))))

       (kill-buffer buf)
       (when (buffer-name obuf)
        (switch-to-buffer obuf))
       (kill-buffer buf)
       (when (buffer-name obuf)
        (switch-to-buffer obuf))


@@ -437,9 +437,9 @@ doubt, use whitespace."
         (one-line (eq verbose 1)))
     (if one-line (setq verbose nil))
     (when (stringp macro)
         (one-line (eq verbose 1)))
     (if one-line (setq verbose nil))
     (when (stringp macro)

-      (loop for i below (length macro) do
-           (when (>= (aref rest-mac i) 128)
-             (incf (aref rest-mac i) (- ?\M-\^@ 128)))))
+      (cl-loop for i below (length macro) do
+               (when (>= (aref rest-mac i) 128)
+                 (cl-incf (aref rest-mac i) (- ?\M-\^@ 128)))))

     (while (not (eq (aref rest-mac 0) 'end-macro))
       (let* ((prefix
              (or (and (integerp (aref rest-mac 0))
     (while (not (eq (aref rest-mac 0) 'end-macro))
       (let* ((prefix
              (or (and (integerp (aref rest-mac 0))


@@ -448,57 +448,58 @@ doubt, use whitespace."
                             '(digit-argument negative-argument))
                       (let ((i 1))
                         (while (memq (aref rest-mac i) (cdr mdigs))
                             '(digit-argument negative-argument))
                       (let ((i 1))
                         (while (memq (aref rest-mac i) (cdr mdigs))

-                          (incf i))
+                          (cl-incf i))

                         (and (not (memq (aref rest-mac i) pkeys))
                              (prog1 (vconcat "M-" (edmacro-subseq rest-mac 0 i) " ")
                         (and (not (memq (aref rest-mac i) pkeys))
                              (prog1 (vconcat "M-" (edmacro-subseq rest-mac 0 i) " ")

-                               (callf edmacro-subseq rest-mac i)))))
+                               (cl-callf edmacro-subseq rest-mac i)))))

                  (and (eq (aref rest-mac 0) ?\C-u)
                       (eq (key-binding [?\C-u]) 'universal-argument)
                       (let ((i 1))
                         (while (eq (aref rest-mac i) ?\C-u)
                  (and (eq (aref rest-mac 0) ?\C-u)
                       (eq (key-binding [?\C-u]) 'universal-argument)
                       (let ((i 1))
                         (while (eq (aref rest-mac i) ?\C-u)

-                          (incf i))
+                          (cl-incf i))

                         (and (not (memq (aref rest-mac i) pkeys))
                         (and (not (memq (aref rest-mac i) pkeys))

-                             (prog1 (loop repeat i concat "C-u ")
-                               (callf edmacro-subseq rest-mac i)))))
+                             (prog1 (cl-loop repeat i concat "C-u ")
+                               (cl-callf edmacro-subseq rest-mac i)))))

                  (and (eq (aref rest-mac 0) ?\C-u)
                       (eq (key-binding [?\C-u]) 'universal-argument)
                       (let ((i 1))
                         (when (eq (aref rest-mac i) ?-)
                  (and (eq (aref rest-mac 0) ?\C-u)
                       (eq (key-binding [?\C-u]) 'universal-argument)
                       (let ((i 1))
                         (when (eq (aref rest-mac i) ?-)

-                          (incf i))
+                          (cl-incf i))

                         (while (memq (aref rest-mac i)
                                      '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
                         (while (memq (aref rest-mac i)
                                      '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))

-                          (incf i))
+                          (cl-incf i))

                         (and (not (memq (aref rest-mac i) pkeys))
                              (prog1 (vconcat "C-u " (edmacro-subseq rest-mac 1 i) " ")
                         (and (not (memq (aref rest-mac i) pkeys))
                              (prog1 (vconcat "C-u " (edmacro-subseq rest-mac 1 i) " ")

-                               (callf edmacro-subseq rest-mac i)))))))
+                               (cl-callf edmacro-subseq rest-mac i)))))))

             (bind-len (apply 'max 1
             (bind-len (apply 'max 1

-                             (loop for map in maps
-                                   for b = (lookup-key map rest-mac)
-                                   when b collect b)))
+                             (cl-loop for map in maps
+                                       for b = (lookup-key map rest-mac)
+                                       when b collect b)))

             (key (edmacro-subseq rest-mac 0 bind-len))
             (fkey nil) tlen tkey
             (key (edmacro-subseq rest-mac 0 bind-len))
             (fkey nil) tlen tkey

-            (bind (or (loop for map in maps for b = (lookup-key map key)
-                            thereis (and (not (integerp b)) b))
+            (bind (or (cl-loop for map in maps for b = (lookup-key map key)
+                                thereis (and (not (integerp b)) b))

                       (and (setq fkey (lookup-key local-function-key-map rest-mac))
                            (setq tlen fkey tkey (edmacro-subseq rest-mac 0 tlen)
                                  fkey (lookup-key local-function-key-map tkey))
                       (and (setq fkey (lookup-key local-function-key-map rest-mac))
                            (setq tlen fkey tkey (edmacro-subseq rest-mac 0 tlen)
                                  fkey (lookup-key local-function-key-map tkey))

-                           (loop for map in maps
-                                 for b = (lookup-key map fkey)
-                                 when (and (not (integerp b)) b)
-                                 do (setq bind-len tlen key tkey)
-                                 and return b
-                                 finally do (setq fkey nil)))))
+                           (cl-loop for map in maps
+                                     for b = (lookup-key map fkey)
+                                     when (and (not (integerp b)) b)
+                                     do (setq bind-len tlen key tkey)
+                                     and return b
+                                     finally do (setq fkey nil)))))

             (first (aref key 0))
             (first (aref key 0))

-            (text (loop for i from bind-len below (length rest-mac)
-                        for ch = (aref rest-mac i)
-                        while (and (integerp ch)
-                                   (> ch 32) (< ch maxkey) (/= ch 92)
-                                   (eq (key-binding (char-to-string ch))
-                                       'self-insert-command)
-                                   (or (> i (- (length rest-mac) 2))
-                                       (not (eq ch (aref rest-mac (+ i 1))))
-                                       (not (eq ch (aref rest-mac (+ i 2))))))
-                        finally return i))
+            (text
+              (cl-loop for i from bind-len below (length rest-mac)
+                       for ch = (aref rest-mac i)
+                       while (and (integerp ch)
+                                  (> ch 32) (< ch maxkey) (/= ch 92)
+                                  (eq (key-binding (char-to-string ch))
+                                      'self-insert-command)
+                                  (or (> i (- (length rest-mac) 2))
+                                      (not (eq ch (aref rest-mac (+ i 1))))
+                                      (not (eq ch (aref rest-mac (+ i 2))))))
+                       finally return i))

             desc)
        (if (stringp bind) (setq bind nil))
        (cond ((and (eq bind 'self-insert-command) (not prefix)
             desc)
        (if (stringp bind) (setq bind nil))
        (cond ((and (eq bind 'self-insert-command) (not prefix)


@@ -509,7 +510,7 @@ doubt, use whitespace."
                      (setq desc (concat (edmacro-subseq rest-mac 0 text)))
                      (when (string-match "^[ACHMsS]-." desc)
                        (setq text 2)
                      (setq desc (concat (edmacro-subseq rest-mac 0 text)))
                      (when (string-match "^[ACHMsS]-." desc)
                        (setq text 2)

-                       (callf substring desc 0 2))
+                       (cl-callf substring desc 0 2))

                      (not (string-match
                            "^;;\\|^<.*>$\\|^\\\\[0-9]+$\\|^[0-9]+\\*."
                            desc))))
                      (not (string-match
                            "^;;\\|^<.*>$\\|^\\\\[0-9]+$\\|^[0-9]+\\*."
                            desc))))


@@ -535,17 +536,17 @@ doubt, use whitespace."
                              (cond
                               ((integerp ch)
                                (concat
                              (cond
                               ((integerp ch)
                                (concat

-                                (loop for pf across "ACHMsS"
-                                      for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@
-                                                   ?\M-\^@ ?\s-\^@ ?\S-\^@)
-                                      when (/= (logand ch bit) 0)
-                                      concat (format "%c-" pf))
+                                (cl-loop for pf across "ACHMsS"
+                                          for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@
+                                                       ?\M-\^@ ?\s-\^@ ?\S-\^@)
+                                          when (/= (logand ch bit) 0)
+                                          concat (format "%c-" pf))

                                 (let ((ch2 (logand ch (1- (lsh 1 18)))))
                                   (cond ((<= ch2 32)
                                 (let ((ch2 (logand ch (1- (lsh 1 18)))))
                                   (cond ((<= ch2 32)

-                                         (case ch2
+                                         (pcase ch2

                                            (0 "NUL") (9 "TAB") (10 "LFD")
                                            (13 "RET") (27 "ESC") (32 "SPC")
                                            (0 "NUL") (9 "TAB") (10 "LFD")
                                            (13 "RET") (27 "ESC") (32 "SPC")

-                                           (t
+                                           (_

                                             (format "C-%c"
                                                     (+ (if (<= ch2 26) 96 64)
                                                        ch2)))))
                                             (format "C-%c"
                                                     (+ (if (<= ch2 26) 96 64)
                                                        ch2)))))


@@ -563,30 +564,30 @@ doubt, use whitespace."
          (let ((times 1) (pos bind-len))
            (while (not (edmacro-mismatch rest-mac rest-mac
                                          0 bind-len pos (+ bind-len pos)))
          (let ((times 1) (pos bind-len))
            (while (not (edmacro-mismatch rest-mac rest-mac
                                          0 bind-len pos (+ bind-len pos)))

-             (incf times)
-             (incf pos bind-len))
+             (cl-incf times)
+             (cl-incf pos bind-len))

            (when (> times 1)
              (setq desc (format "%d*%s" times desc))
              (setq bind-len (* bind-len times)))))
        (setq rest-mac (edmacro-subseq rest-mac bind-len))
        (if verbose
            (progn
            (when (> times 1)
              (setq desc (format "%d*%s" times desc))
              (setq bind-len (* bind-len times)))))
        (setq rest-mac (edmacro-subseq rest-mac bind-len))
        (if verbose
            (progn

-             (unless (equal res "") (callf concat res "\n"))
-             (callf concat res desc)
+             (unless (equal res "") (cl-callf concat res "\n"))
+             (cl-callf concat res desc)

              (when (and bind (or (stringp bind) (symbolp bind)))
              (when (and bind (or (stringp bind) (symbolp bind)))

-               (callf concat res
+               (cl-callf concat res

                  (make-string (max (- 3 (/ (length desc) 8)) 1) 9)
                  ";; " (if (stringp bind) bind (symbol-name bind))))
              (setq len 0))
          (if (and (> (+ len (length desc) 2) 72) (not one-line))
              (progn
                  (make-string (max (- 3 (/ (length desc) 8)) 1) 9)
                  ";; " (if (stringp bind) bind (symbol-name bind))))
              (setq len 0))
          (if (and (> (+ len (length desc) 2) 72) (not one-line))
              (progn

-               (callf concat res "\n ")
+               (cl-callf concat res "\n ")

                (setq len 1))
            (unless (equal res "")
                (setq len 1))
            (unless (equal res "")

-             (callf concat res " ")
-             (incf len)))
-         (callf concat res desc)
-         (incf len (length desc)))))
+             (cl-callf concat res " ")
+             (cl-incf len)))
+         (cl-callf concat res desc)
+         (cl-incf len (length desc)))))

     res))
 
 (defun edmacro-mismatch (cl-seq1 cl-seq2 cl-start1 cl-end1 cl-start2 cl-end2)
     res))
 
 (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."
 The string represents the same events; Meta is indicated by bit 7.
 This function assumes that the events can be stored in a string."
   (setq seq (copy-sequence seq))
 The string represents the same events; Meta is indicated by bit 7.
 This function assumes that the events can be stored in a string."
   (setq seq (copy-sequence seq))

-  (loop for i below (length seq) do
-        (when (logand (aref seq i) 128)
-          (setf (aref seq i) (logand (aref seq i) 127))))
+  (cl-loop for i below (length seq) do
+           (when (logand (aref seq i) 128)
+             (setf (aref seq i) (logand (aref seq i) 127))))

   seq)
 
 (defun edmacro-fix-menu-commands (macro &optional noerror)
   seq)
 
 (defun edmacro-fix-menu-commands (macro &optional noerror)


@@ -655,7 +656,7 @@ This function assumes that the events can be stored in a string."
                ((eq (car ev) 'switch-frame))
                ((equal ev '(menu-bar))
                 (push 'menu-bar result))
                ((eq (car ev) 'switch-frame))
                ((equal ev '(menu-bar))
                 (push 'menu-bar result))

-               ((equal (cadadr ev) '(menu-bar))
+               ((equal (cl-cadadr ev) '(menu-bar))

                 (push (vector 'menu-bar (car ev)) result))
                ;; It would be nice to do pop-up menus, too, but not enough
                ;; info is recorded in macros to make this possible.
                 (push (vector 'menu-bar (car ev)) result))
                ;; It would be nice to do pop-up menus, too, but not enough
                ;; 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."
              (t
               (let ((orig-word word) (prefix 0) (bits 0))
                 (while (string-match "^[ACHMsS]-." word)
              (t
               (let ((orig-word word) (prefix 0) (bits 0))
                 (while (string-match "^[ACHMsS]-." word)

-                  (incf bits (cdr (assq (aref word 0)
+                  (cl-incf bits (cdr (assq (aref word 0)

                                         '((?A . ?\A-\^@) (?C . ?\C-\^@)
                                           (?H . ?\H-\^@) (?M . ?\M-\^@)
                                           (?s . ?\s-\^@) (?S . ?\S-\^@)))))
                                         '((?A . ?\A-\^@) (?C . ?\C-\^@)
                                           (?H . ?\H-\^@) (?M . ?\M-\^@)
                                           (?s . ?\s-\^@) (?S . ?\S-\^@)))))

-                  (incf prefix 2)
-                  (callf substring word 2))
+                  (cl-incf prefix 2)
+                  (cl-callf substring word 2))

                 (when (string-match "^\\^.$" word)
                 (when (string-match "^\\^.$" word)

-                  (incf bits ?\C-\^@)
-                  (incf prefix)
-                  (callf substring word 1))
+                  (cl-incf bits ?\C-\^@)
+                  (cl-incf prefix)
+                  (cl-callf substring word 1))

                 (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r")
                                            ("LFD" . "\n") ("TAB" . "\t")
                                            ("ESC" . "\e") ("SPC" . " ")
                                            ("DEL" . "\177")))))
                   (when found (setq word (cdr found))))
                 (when (string-match "^\\\\[0-7]+$" word)
                 (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r")
                                            ("LFD" . "\n") ("TAB" . "\t")
                                            ("ESC" . "\e") ("SPC" . " ")
                                            ("DEL" . "\177")))))
                   (when found (setq word (cdr found))))
                 (when (string-match "^\\\\[0-7]+$" word)

-                  (loop for ch across word
-                        for n = 0 then (+ (* n 8) ch -48)
-                        finally do (setq word (vector n))))
+                  (cl-loop for ch across word
+                            for n = 0 then (+ (* n 8) ch -48)
+                            finally do (setq word (vector n))))

                 (cond ((= bits 0)
                        (setq key word))
                       ((and (= bits ?\M-\^@) (stringp word)
                             (string-match "^-?[0-9]+$" word))
                 (cond ((= bits 0)
                        (setq key word))
                       ((and (= bits ?\M-\^@) (stringp word)
                             (string-match "^-?[0-9]+$" word))

-                       (setq key (loop for x across word collect (+ x bits))))
+                       (setq key (cl-loop for x across word
+                                           collect (+ x bits))))

                       ((/= (length word) 1)
                        (error "%s must prefix a single character, not %s"
                               (substring orig-word 0 prefix) word))
                       ((/= (length word) 1)
                        (error "%s must prefix a single character, not %s"
                               (substring orig-word 0 prefix) word))


@@ -752,7 +754,7 @@ This function assumes that the events can be stored in a string."
                       (t
                        (setq key (list (+ bits (aref word 0)))))))))
        (when key
                       (t
                        (setq key (list (+ bits (aref word 0)))))))))
        (when key

-         (loop repeat times do (callf vconcat res key)))))
+         (cl-loop repeat times do (cl-callf vconcat res key)))))

     (when (and (>= (length res) 4)
               (eq (aref res 0) ?\C-x)
               (eq (aref res 1) ?\()
     (when (and (>= (length res) 4)
               (eq (aref res 0) ?\C-x)
               (eq (aref res 1) ?\()


@@ -760,13 +762,13 @@ This function assumes that the events can be stored in a string."
               (eq (aref res (- (length res) 1)) ?\)))
       (setq res (edmacro-subseq res 2 -2)))
     (if (and (not need-vector)
               (eq (aref res (- (length res) 1)) ?\)))
       (setq res (edmacro-subseq res 2 -2)))
     (if (and (not need-vector)

-            (loop for ch across res
-                  always (and (characterp ch)
-                              (let ((ch2 (logand ch (lognot ?\M-\^@))))
-                                (and (>= ch2 0) (<= ch2 127))))))
-       (concat (loop for ch across res
-                     collect (if (= (logand ch ?\M-\^@) 0)
-                                 ch (+ ch 128))))
+            (cl-loop for ch across res
+                      always (and (characterp ch)
+                                  (let ((ch2 (logand ch (lognot ?\M-\^@))))
+                                    (and (>= ch2 0) (<= ch2 127))))))
+       (concat (cl-loop for ch across res
+                         collect (if (= (logand ch ?\M-\^@) 0)
+                                     ch (+ ch 128))))

       res)))
 
 (provide 'edmacro)
       res)))
 
 (provide 'edmacro)

diff --git a/lisp/electric.el b/lisp/electric.el
index 6a31ba1..5f14455 100644 (file)
--- a/lisp/electric.el
+++ b/lisp/electric.el
@@ -38,8 +38,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
-

 ;; This loop is the guts for non-standard modes which retain control
 ;; until some event occurs.  It is a `do-forever', the only way out is
 ;; to throw.  It assumes that you have set up the keymap, window, and
 ;; This loop is the guts for non-standard modes which retain control
 ;; until some event occurs.  It is a `do-forever', the only way out is
 ;; to throw.  It assumes that you have set up the keymap, window, and


@@ -394,16 +392,16 @@ arguments that returns one of those symbols.")
                (not (nth 8 (save-excursion (syntax-ppss pos)))))
       (let ((end (copy-marker (point) t)))
         (goto-char pos)
                (not (nth 8 (save-excursion (syntax-ppss pos)))))
       (let ((end (copy-marker (point) t)))
         (goto-char pos)

-        (case (if (functionp rule) (funcall rule) rule)
+        (pcase (if (functionp rule) (funcall rule) rule)

           ;; FIXME: we used `newline' down here which called
           ;; self-insert-command and ran post-self-insert-hook recursively.
           ;; It happened to make electric-indent-mode work automatically with
           ;; electric-layout-mode (at the cost of re-indenting lines
           ;; multiple times), but I'm not sure it's what we want.
           ;; FIXME: we used `newline' down here which called
           ;; self-insert-command and ran post-self-insert-hook recursively.
           ;; It happened to make electric-indent-mode work automatically with
           ;; electric-layout-mode (at the cost of re-indenting lines
           ;; multiple times), but I'm not sure it's what we want.

-          (before (goto-char (1- pos)) (skip-chars-backward " \t")
+          (`before (goto-char (1- pos)) (skip-chars-backward " \t")

                   (unless (bolp) (insert "\n")))
                   (unless (bolp) (insert "\n")))

-          (after  (insert "\n"))       ; FIXME: check eolp before inserting \n?
-          (around (save-excursion
+          (`after  (insert "\n"))      ; FIXME: check eolp before inserting \n?
+          (`around (save-excursion

                     (goto-char (1- pos)) (skip-chars-backward " \t")
                     (unless (bolp) (insert "\n")))
                   (insert "\n")))      ; FIXME: check eolp before inserting \n?
                     (goto-char (1- pos)) (skip-chars-backward " \t")
                     (unless (bolp) (insert "\n")))
                   (insert "\n")))      ; FIXME: check eolp before inserting \n?

diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index fba8915..1bdd6d8 100644 (file)
--- 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."
                    define-overloadable-function))
       (let* ((macrop (memq car '(defmacro defmacro*)))
             (name (nth 1 form))
                    define-overloadable-function))
       (let* ((macrop (memq car '(defmacro defmacro*)))
             (name (nth 1 form))

-            (args (cl-case car
-                     ((defun defmacro defun* defmacro*
-                        define-overloadable-function) (nth 2 form))
-                     ((define-skeleton) '(&optional str arg))
-                     ((define-generic-mode define-derived-mode
-                        define-compilation-mode) nil)
-                     (t)))
+            (args (pcase car
+                     ((or `defun `defmacro
+                          `defun* `defmacro* `cl-defun `cl-defmacro
+                          `define-overloadable-function) (nth 2 form))
+                     (`define-skeleton '(&optional str arg))
+                     ((or `define-generic-mode `define-derived-mode
+                          `define-compilation-mode) nil)
+                     (_ t)))

             (body (nthcdr (or (get car 'doc-string-elt) 3) form))
             (doc (if (stringp (car body)) (pop body))))
         ;; Add the usage form at the end where describe-function-1
             (body (nthcdr (or (get car 'doc-string-elt) 3) form))
             (doc (if (stringp (car body)) (pop body))))
         ;; 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 8822c03..5a3fd7d 100644 (file)
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -630,10 +630,10 @@
   (while (eq (car-safe form) 'progn)
     (setq form (car (last (cdr form)))))
   (cond ((consp form)
   (while (eq (car-safe form) 'progn)
     (setq form (car (last (cdr form)))))
   (cond ((consp form)

-         (cl-case (car form)
-           (quote (cadr form))
+         (pcase (car form)
+           (`quote (cadr form))

            ;; Can't use recursion in a defsubst.
            ;; Can't use recursion in a defsubst.

-           ;; (progn (byte-compile-trueconstp (car (last (cdr form)))))
+           ;; (`progn (byte-compile-trueconstp (car (last (cdr form)))))

            ))
         ((not (symbolp form)))
         ((eq form t))
            ))
         ((not (symbolp form)))
         ((eq form t))


@@ -644,10 +644,10 @@
   (while (eq (car-safe form) 'progn)
     (setq form (car (last (cdr form)))))
   (cond ((consp form)
   (while (eq (car-safe form) 'progn)
     (setq form (car (last (cdr form)))))
   (cond ((consp form)

-         (cl-case (car form)
-           (quote (null (cadr form)))
+         (pcase (car form)
+           (`quote (null (cadr form)))

            ;; Can't use recursion in a defsubst.
            ;; Can't use recursion in a defsubst.

-           ;; (progn (byte-compile-nilconstp (car (last (cdr form)))))
+           ;; (`progn (byte-compile-nilconstp (car (last (cdr form)))))

            ))
         ((not (symbolp form)) nil)
         ((null form))))
            ))
         ((not (symbolp form)) nil)
         ((null form))))

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 76b147a..751515b 100644 (file)
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1591,10 +1591,11 @@ that already has a `.elc' file."
                         (not (auto-save-file-name-p source))
                         (not (string-equal dir-locals-file
                                            (file-name-nondirectory source))))
                         (not (auto-save-file-name-p source))
                         (not (string-equal dir-locals-file
                                            (file-name-nondirectory source))))

-                   (progn (cl-case (byte-recompile-file source force arg)
-                            (no-byte-compile (setq skip-count (1+ skip-count)))
-                            ((t) (setq file-count (1+ file-count)))
-                            ((nil) (setq fail-count (1+ fail-count))))
+                   (progn (incf
+                           (pcase (byte-recompile-file source force arg)
+                             (`no-byte-compile skip-count)
+                             (`t file-count)
+                             (_ fail-count)))

                           (or noninteractive
                               (message "Checking %s..." directory))
                           (if (not (eq last-dir directory))
                           (or noninteractive
                               (message "Checking %s..." directory))
                           (if (not (eq last-dir directory))


@@ -2974,12 +2975,12 @@ That command is designed for interactive use only" fn))
       ;; Old-style byte-code.
       (cl-assert (listp fargs))
       (while fargs
       ;; Old-style byte-code.
       (cl-assert (listp fargs))
       (while fargs

-        (cl-case (car fargs)
-          (&optional (setq fargs (cdr fargs)))
-          (&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1))
+        (pcase (car fargs)
+          (`&optional (setq fargs (cdr fargs)))
+          (`&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1))

                  (push (cadr fargs) dynbinds)
                  (setq fargs nil))
                  (push (cadr fargs) dynbinds)
                  (setq fargs nil))

-          (t (push (pop fargs) dynbinds))))
+          (_ (push (pop fargs) dynbinds))))

       (unless fmax2 (setq fmax2 (* 2 (length dynbinds)))))
     (cond
      ((<= (+ alen alen) fmax2)
       (unless fmax2 (setq fmax2 (* 2 (length dynbinds)))))
     (cond
      ((<= (+ alen alen) fmax2)


@@ -3024,10 +3025,10 @@ That command is designed for interactive use only" fn))
            (and od
                 (not (memq var byte-compile-not-obsolete-vars))
                 (not (memq var byte-compile-global-not-obsolete-vars))
            (and od
                 (not (memq var byte-compile-not-obsolete-vars))
                 (not (memq var byte-compile-global-not-obsolete-vars))

-                (or (cl-case (nth 1 od)
-                      (set (not (eq access-type 'reference)))
-                      (get (eq access-type 'reference))
-                      (t t)))))
+                (or (pcase (nth 1 od)
+                      (`set (not (eq access-type 'reference)))
+                      (`get (eq access-type 'reference))
+                      (_ t)))))

         (byte-compile-warn-obsolete var))))
 
 (defsubst byte-compile-dynamic-variable-op (base-op var)
         (byte-compile-warn-obsolete var))))
 
 (defsubst byte-compile-dynamic-variable-op (base-op var)


@@ -4351,21 +4352,21 @@ invoked interactively."
     (if byte-compile-call-tree-sort
        (setq byte-compile-call-tree
              (sort byte-compile-call-tree
     (if byte-compile-call-tree-sort
        (setq byte-compile-call-tree
              (sort byte-compile-call-tree

-                   (cl-case byte-compile-call-tree-sort
-                      (callers
+                   (pcase byte-compile-call-tree-sort
+                      (`callers

                        (lambda (x y) (< (length (nth 1 x))
                                    (length (nth 1 y)))))
                        (lambda (x y) (< (length (nth 1 x))
                                    (length (nth 1 y)))))

-                      (calls
+                      (`calls

                        (lambda (x y) (< (length (nth 2 x))
                                    (length (nth 2 y)))))
                        (lambda (x y) (< (length (nth 2 x))
                                    (length (nth 2 y)))))

-                      (calls+callers
+                      (`calls+callers

                        (lambda (x y) (< (+ (length (nth 1 x))
                                       (length (nth 2 x)))
                                    (+ (length (nth 1 y))
                                       (length (nth 2 y))))))
                        (lambda (x y) (< (+ (length (nth 1 x))
                                       (length (nth 2 x)))
                                    (+ (length (nth 1 y))
                                       (length (nth 2 y))))))

-                      (name
+                      (`name

                        (lambda (x y) (string< (car x) (car y))))
                        (lambda (x y) (string< (car x) (car y))))

-                      (t (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode"
+                      (_ (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode"

                                 byte-compile-call-tree-sort))))))
     (message "Generating call tree...")
     (let ((rest byte-compile-call-tree)
                                 byte-compile-call-tree-sort))))))
     (message "Generating call tree...")
     (let ((rest byte-compile-call-tree)

diff --git a/lisp/emulation/crisp.el b/lisp/emulation/crisp.el
index cfb8ed0..d29736d 100644 (file)
--- a/lisp/emulation/crisp.el
+++ b/lisp/emulation/crisp.el
@@ -54,8 +54,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
-

 ;; local variables
 
 (defgroup crisp nil
 ;; local variables
 
 (defgroup crisp nil


@@ -361,7 +359,7 @@ if ARG is omitted or nil."
   (when crisp-mode
     ;; Make menu entries show M-u or f14 in preference to C-x u.
     (put 'undo :advertised-binding
   (when crisp-mode
     ;; Make menu entries show M-u or f14 in preference to C-x u.
     (put 'undo :advertised-binding

-         (list* [?\M-u] [f14] (get 'undo :advertised-binding)))
+         `([?\M-u] [f14] ,@(get 'undo :advertised-binding)))

     ;; Force transient-mark-mode, so that the marking routines work as
     ;; expected.  If the user turns off transient mark mode, most
     ;; things will still work fine except the crisp-(copy|kill)
     ;; Force transient-mark-mode, so that the marking routines work as
     ;; expected.  If the user turns off transient mark mode, most
     ;; things will still work fine except the crisp-(copy|kill)

diff --git a/lisp/face-remap.el b/lisp/face-remap.el
index e2f9e3d..09503d7 100644 (file)
--- a/lisp/face-remap.el
+++ b/lisp/face-remap.el
@@ -315,9 +315,9 @@ a top-level keymap, `text-scale-increase' or
     (let* ((base (event-basic-type ev))
            (step
             (pcase base
     (let* ((base (event-basic-type ev))
            (step
             (pcase base

-              ((or `?+ `?=) inc)
-              (`?- (- inc))
-              (`?0 0)
+              ((or ?+ ?=) inc)
+              (?- (- inc))
+              (?0 0)

               (t inc))))
       (text-scale-increase step)
       ;; FIXME: do it after every "iteration of the loop".
               (t inc))))
       (text-scale-increase step)
       ;; FIXME: do it after every "iteration of the loop".

diff --git a/lisp/filesets.el b/lisp/filesets.el
index 86ebe47..6c24a4f 100644 (file)
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -88,9 +88,7 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile
-  (require 'cl))
-
+(eval-when-compile (require 'cl-lib))

 
 ;;; Some variables
 
 
 ;;; Some variables
 


@@ -1286,11 +1284,11 @@ on-close-all ... Not used"
              (or entry
                  (filesets-get-external-viewer filename)))))
     (filesets-alist-get def
              (or entry
                  (filesets-get-external-viewer filename)))))
     (filesets-alist-get def

-                       (case event
-                         ((on-open-all)       ':ignore-on-open-all)
-                         ((on-grep)           ':ignore-on-read-text)
-                         ((on-cmd) nil)
-                         ((on-close-all) nil))
+                       (pcase event
+                         (`on-open-all       ':ignore-on-open-all)
+                         (`on-grep           ':ignore-on-read-text)
+                         (`on-cmd nil)
+                         (`on-close-all nil))

                        nil t)))
 
 (defun filesets-filetype-get-prop (property filename &optional entry)
                        nil t)))
 
 (defun filesets-filetype-get-prop (property filename &optional entry)


@@ -1559,11 +1557,9 @@ SAVE-FUNCTION takes no argument, but works on the current buffer."
 
 (defun filesets-get-fileset-from-name (name &optional mode)
   "Get fileset definition for NAME."
 
 (defun filesets-get-fileset-from-name (name &optional mode)
   "Get fileset definition for NAME."

-  (case mode
-    ((:ingroup :tree)
-     name)
-    (t
-     (assoc name filesets-data))))
+  (pcase mode
+    ((or `:ingroup `:tree) name)
+    (_ (assoc name filesets-data))))

 
 
 ;;; commands
 
 
 ;;; commands


@@ -1720,22 +1716,22 @@ Replace <file-name> or <<file-name>> with filename."
 Assume MODE (see `filesets-entry-mode'), if provided."
   (let* ((mode (or mode
                   (filesets-entry-mode entry)))
 Assume MODE (see `filesets-entry-mode'), if provided."
   (let* ((mode (or mode
                   (filesets-entry-mode entry)))

-        (fl (case mode
-              ((:files)
+        (fl (pcase mode
+              (:files

                (filesets-entry-get-files entry))
                (filesets-entry-get-files entry))

-              ((:file)
+              (:file

                (list (filesets-entry-get-file entry)))
                (list (filesets-entry-get-file entry)))

-              ((:ingroup)
+              (:ingroup

                (let ((entry (expand-file-name
                              (if (stringp entry)
                                  entry
                                (filesets-entry-get-master entry)))))
                  (cons entry (filesets-ingroup-cache-get entry))))
                (let ((entry (expand-file-name
                              (if (stringp entry)
                                  entry
                                (filesets-entry-get-master entry)))))
                  (cons entry (filesets-ingroup-cache-get entry))))

-              ((:tree)
+              (:tree

                (let ((dir  (nth 0 entry))
                      (patt (nth 1 entry)))
                  (filesets-directory-files dir patt ':files t)))
                (let ((dir  (nth 0 entry))
                      (patt (nth 1 entry)))
                  (filesets-directory-files dir patt ':files t)))

-              ((:pattern)
+              (:pattern

                (let ((dirpatt (filesets-entry-get-pattern entry)))
                  (if dirpatt
                      (let ((dir (filesets-entry-get-pattern--dir dirpatt))
                (let ((dirpatt (filesets-entry-get-pattern entry)))
                  (if dirpatt
                      (let ((dir (filesets-entry-get-pattern--dir dirpatt))


@@ -1904,12 +1900,12 @@ User will be queried, if no fileset name is provided."
       (let* ((result  nil)
             (factor (ceiling (/ (float bl)
                                 filesets-max-submenu-length))))
       (let* ((result  nil)
             (factor (ceiling (/ (float bl)
                                 filesets-max-submenu-length))))

-       (do ((data  submenu-body (cdr data))
-            (n     1            (+ n 1))
-            (count 0            (+ count factor)))
+       (cl-do ((data  submenu-body (cdr data))
+                (n     1            (+ n 1))
+                (count 0            (+ count factor)))

            ((or (> count bl)
                 (null data)))
            ((or (> count bl)
                 (null data)))

-;        (let ((sl (subseq submenu-body count
+         ;; (let ((sl (subseq submenu-body count

          (let ((sl (filesets-sublist submenu-body count
                                      (let ((x (+ count factor)))
                                        (if (>= bl x)
          (let ((sl (filesets-sublist submenu-body count
                                      (let ((x (+ count factor)))
                                        (if (>= bl x)


@@ -1926,7 +1922,7 @@ User will be queried, if no fileset name is provided."
                       `((,(concat
                            (filesets-get-shortcut n)
                            (let ((rv ""))
                       `((,(concat
                            (filesets-get-shortcut n)
                            (let ((rv ""))

-                             (do ((x sl (cdr x)))
+                             (cl-do ((x sl (cdr x)))

                                  ((null x))
                                (let ((y (concat (elt (car x) 0)
                                                 (if (null (cdr x))
                                  ((null x))
                                (let ((y (concat (elt (car x) 0)
                                                 (if (null (cdr x))


@@ -1952,8 +1948,8 @@ User will be queried, if no fileset name is provided."
   "Get submenu epilog for SOMETHING (usually a fileset).
 If mode is :tree or :ingroup, SOMETHING is some weird construct and
 LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
   "Get submenu epilog for SOMETHING (usually a fileset).
 If mode is :tree or :ingroup, SOMETHING is some weird construct and
 LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."

-  (case mode
-    ((:tree)
+  (pcase mode
+    (:tree

      `("---"
        ["Close all files" (filesets-close ',mode ',something ',lookup-name)]
        ["Run Command"     (filesets-run-cmd nil ',something ',mode)]
      `("---"
        ["Close all files" (filesets-close ',mode ',something ',lookup-name)]
        ["Run Command"     (filesets-run-cmd nil ',something ',mode)]


@@ -1962,14 +1958,14 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
        ,@(when rebuild-flag
           `(["Rebuild this submenu"
              (filesets-rebuild-this-submenu ',lookup-name)]))))
        ,@(when rebuild-flag
           `(["Rebuild this submenu"
              (filesets-rebuild-this-submenu ',lookup-name)]))))

-    ((:ingroup)
+    (:ingroup

      `("---"
        ["Close all files" (filesets-close ',mode ',something ',lookup-name)]
        ["Run Command"     (filesets-run-cmd nil ',something ',mode)]
        ,@(when rebuild-flag
           `(["Rebuild this submenu"
              (filesets-rebuild-this-submenu ',lookup-name)]))))
      `("---"
        ["Close all files" (filesets-close ',mode ',something ',lookup-name)]
        ["Run Command"     (filesets-run-cmd nil ',something ',mode)]
        ,@(when rebuild-flag
           `(["Rebuild this submenu"
              (filesets-rebuild-this-submenu ',lookup-name)]))))

-    ((:pattern)
+    (:pattern

      `("---"
        ["Close all files" (filesets-close ',mode ',something)]
        ["Run Command"     (filesets-run-cmd nil ',something ',mode)]
      `("---"
        ["Close all files" (filesets-close ',mode ',something)]
        ["Run Command"     (filesets-run-cmd nil ',something ',mode)]


@@ -1986,7 +1982,7 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
        ,@(when rebuild-flag
           `(["Rebuild this submenu"
              (filesets-rebuild-this-submenu ',lookup-name)]))))
        ,@(when rebuild-flag
           `(["Rebuild this submenu"
              (filesets-rebuild-this-submenu ',lookup-name)]))))

-    ((:files)
+    (:files

      `("---"
        [,(concat "Close all files") (filesets-close ',mode ',something)]
        ["Run Command"               (filesets-run-cmd nil ',something ',mode)]
      `("---"
        [,(concat "Close all files") (filesets-close ',mode ',something)]
        ["Run Command"               (filesets-run-cmd nil ',something ',mode)]


@@ -1997,7 +1993,7 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
        ,@(when rebuild-flag
           `(["Rebuild this submenu"
              (filesets-rebuild-this-submenu ',lookup-name)]))))
        ,@(when rebuild-flag
           `(["Rebuild this submenu"
              (filesets-rebuild-this-submenu ',lookup-name)]))))

-    (t
+    (_

      (filesets-error 'error "Filesets: malformed definition of " something))))
 
 (defun filesets-ingroup-get-data (master pos &optional fun)
      (filesets-error 'error "Filesets: malformed definition of " something))))
 
 (defun filesets-ingroup-get-data (master pos &optional fun)


@@ -2249,15 +2245,15 @@ Construct a shortcut from COUNT."
          (filesets-verbosity (filesets-entry-get-verbosity entry))
          (this-lookup-name (concat (filesets-get-shortcut count)
                                    lookup-name)))
          (filesets-verbosity (filesets-entry-get-verbosity entry))
          (this-lookup-name (concat (filesets-get-shortcut count)
                                    lookup-name)))

-      (case mode
-       ((:file)
+      (pcase mode
+       (:file

         (let* ((file (filesets-entry-get-file entry)))
           `[,this-lookup-name
             (filesets-file-open nil ',file ',lookup-name)]))
         (let* ((file (filesets-entry-get-file entry)))
           `[,this-lookup-name
             (filesets-file-open nil ',file ',lookup-name)]))

-       (t
+       (_

         `(,this-lookup-name
         `(,this-lookup-name

-          ,@(case mode
-              ((:pattern)
+          ,@(pcase mode
+              (:pattern

                (let* ((files    (filesets-get-filelist entry mode 'on-ls))
                       (dirpatt  (filesets-entry-get-pattern entry))
                       (pattname (apply 'concat (cons "Pattern: " dirpatt)))
                (let* ((files    (filesets-get-filelist entry mode 'on-ls))
                       (dirpatt  (filesets-entry-get-pattern entry))
                       (pattname (apply 'concat (cons "Pattern: " dirpatt)))


@@ -2276,7 +2272,7 @@ Construct a shortcut from COUNT."
                        files))
                    ,@(filesets-get-menu-epilog lookup-name mode
                                                lookup-name t))))
                        files))
                    ,@(filesets-get-menu-epilog lookup-name mode
                                                lookup-name t))))

-              ((:ingroup)
+              (:ingroup

                (let* ((master (filesets-entry-get-master entry)))
                  ;;(filesets-message 3 "Filesets: parsing %S" master)
                  `([,(concat "Inclusion Group: "
                (let* ((master (filesets-entry-get-master entry)))
                  ;;(filesets-message 3 "Filesets: parsing %S" master)
                  `([,(concat "Inclusion Group: "


@@ -2288,12 +2284,12 @@ Construct a shortcut from COUNT."
                    ,@(filesets-wrap-submenu
                       (filesets-build-ingroup-submenu lookup-name master))
                    ,@(filesets-get-menu-epilog master mode lookup-name t))))
                    ,@(filesets-wrap-submenu
                       (filesets-build-ingroup-submenu lookup-name master))
                    ,@(filesets-get-menu-epilog master mode lookup-name t))))

-              ((:tree)
+              (:tree

                (let* ((dirpatt (filesets-entry-get-tree entry))
                       (dir     (car dirpatt))
                       (patt    (cadr dirpatt)))
                  (filesets-build-dir-submenu entry lookup-name dir patt)))
                (let* ((dirpatt (filesets-entry-get-tree entry))
                       (dir     (car dirpatt))
                       (patt    (cadr dirpatt)))
                  (filesets-build-dir-submenu entry lookup-name dir patt)))

-              ((:files)
+              (:files

                (let ((files (filesets-get-filelist entry mode 'on-open-all))
                      (count 0))
                  `([,(concat "Files: " lookup-name)
                (let ((files (filesets-get-filelist entry mode 'on-open-all))
                      (count 0))
                  `([,(concat "Files: " lookup-name)


@@ -2331,9 +2327,9 @@ bottom up, set `filesets-submenus' to nil, first.)"
     (setq filesets-has-changed-flag nil)
     (setq filesets-updated-buffers nil)
     (setq filesets-update-cache-file-flag t)
     (setq filesets-has-changed-flag nil)
     (setq filesets-updated-buffers nil)
     (setq filesets-update-cache-file-flag t)

-    (do ((data  (filesets-conditional-sort filesets-data (function car))
-               (cdr data))
-        (count 1 (+ count 1)))
+    (cl-do ((data  (filesets-conditional-sort filesets-data (function car))
+                   (cdr data))
+            (count 1 (+ count 1)))

        ((null data))
       (let* ((this    (car data))
             (name    (filesets-data-get-name this))
        ((null data))
       (let* ((this    (car data))
             (name    (filesets-data-get-name this))

diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index de2e043..f3e313e 100644 (file)
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -207,7 +207,7 @@
 ;;; Code:
 
 (require 'syntax)
 ;;; Code:
 
 (require 'syntax)

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))

 
 ;; Define core `font-lock' group.
 (defgroup font-lock '((jit-lock custom-group))
 
 ;; Define core `font-lock' group.
 (defgroup font-lock '((jit-lock custom-group))


@@ -613,9 +613,6 @@ Major/minor modes can set this variable if they know which option applies.")
 ;; Font Lock mode.
 
 (eval-when-compile
 ;; Font Lock mode.
 
 (eval-when-compile

-  ;;
-  ;; We don't do this at the top-level as we only use non-autoloaded macros.
-  (require 'cl)

   ;;
   ;; Borrowed from lazy-lock.el.
   ;; We use this to preserve or protect things when modifying text properties.
   ;;
   ;; Borrowed from lazy-lock.el.
   ;; We use this to preserve or protect things when modifying text properties.


@@ -917,10 +914,10 @@ The value of this variable is used when Font Lock mode is turned on."
 (declare-function lazy-lock-mode "lazy-lock")
 
 (defun font-lock-turn-on-thing-lock ()
 (declare-function lazy-lock-mode "lazy-lock")
 
 (defun font-lock-turn-on-thing-lock ()

-  (case (font-lock-value-in-major-mode font-lock-support-mode)
-    (fast-lock-mode (fast-lock-mode t))
-    (lazy-lock-mode (lazy-lock-mode t))
-    (jit-lock-mode
+  (pcase (font-lock-value-in-major-mode font-lock-support-mode)
+    (`fast-lock-mode (fast-lock-mode t))
+    (`lazy-lock-mode (lazy-lock-mode t))
+    (`jit-lock-mode

      ;; Prepare for jit-lock
      (remove-hook 'after-change-functions
                   'font-lock-after-change-function t)
      ;; Prepare for jit-lock
      (remove-hook 'after-change-functions
                   'font-lock-after-change-function t)


@@ -1654,7 +1651,7 @@ LOUDLY, if non-nil, allows progress-meter bar."
     ;; Fontify each item in `font-lock-keywords' from `start' to `end'.
     (while keywords
       (if loudly (message "Fontifying %s... (regexps..%s)" bufname
     ;; Fontify each item in `font-lock-keywords' from `start' to `end'.
     (while keywords
       (if loudly (message "Fontifying %s... (regexps..%s)" bufname

-                         (make-string (incf count) ?.)))
+                         (make-string (cl-incf count) ?.)))

       ;;
       ;; Find an occurrence of `matcher' from `start' to `end'.
       (setq keyword (car keywords) matcher (car keyword))
       ;;
       ;; Find an occurrence of `matcher' from `start' to `end'.
       (setq keyword (car keywords) matcher (car keyword))

diff --git a/lisp/frame.el b/lisp/frame.el
index 43704d3..7780283 100644 (file)
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -25,8 +25,6 @@
 ;;; Commentary:
 
 ;;; Code:
 ;;; Commentary:
 
 ;;; Code:

-(eval-when-compile (require 'cl))
-

 (defvar frame-creation-function-alist
   (list (cons nil
              (if (fboundp 'tty-create-frame-with-faces)
 (defvar frame-creation-function-alist
   (list (cons nil
              (if (fboundp 'tty-create-frame-with-faces)

diff --git a/lisp/hexl.el b/lisp/hexl.el
index a754a15..fcdef74 100644 (file)
--- a/lisp/hexl.el
+++ b/lisp/hexl.el
@@ -41,7 +41,7 @@
 ;;; Code:
 
 (require 'eldoc)
 ;;; Code:
 
 (require 'eldoc)

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl))       ;For letf (default-value 'major-mode).

 
 ;;
 ;; vars here
 
 ;;
 ;; vars here

diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 46ce6aa..fabc12c 100644 (file)
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -34,7 +34,7 @@
 ;;; Code:
 
 (require 'image)
 ;;; Code:
 
 (require 'image)

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))

 
 ;;; Image mode window-info management.
 
 
 ;;; Image mode window-info management.
 


@@ -70,12 +70,11 @@ A winprops object has the shape (WINDOW . ALIST)."
     winprops))
 
 (defun image-mode-window-get (prop &optional winprops)
     winprops))
 
 (defun image-mode-window-get (prop &optional winprops)

+  (declare (gv-setter (lambda (val)
+                        `(image-mode-window-put ,prop ,val ,winprops))))

   (unless (consp winprops) (setq winprops (image-mode-winprops winprops)))
   (cdr (assq prop (cdr winprops))))
 
   (unless (consp winprops) (setq winprops (image-mode-winprops winprops)))
   (cdr (assq prop (cdr winprops))))
 

-(defsetf image-mode-window-get (prop &optional winprops) (val)
-  `(image-mode-window-put ,prop ,val ,winprops))
-

 (defun image-mode-window-put (prop val &optional winprops)
   (unless (consp winprops) (setq winprops (image-mode-winprops winprops)))
   (setcdr winprops (cons (cons prop val)
 (defun image-mode-window-put (prop val &optional winprops)
   (unless (consp winprops) (setq winprops (image-mode-winprops winprops)))
   (setcdr winprops (cons (cons prop val)


@@ -692,20 +691,20 @@ a slightly different angle.  Currently this is done for values
 close to a multiple of 90, see `image-transform-right-angle-fudge'."
   (cond ((< (abs (- (mod (+ image-transform-rotation 90) 180) 90))
            image-transform-right-angle-fudge)
 close to a multiple of 90, see `image-transform-right-angle-fudge'."
   (cond ((< (abs (- (mod (+ image-transform-rotation 90) 180) 90))
            image-transform-right-angle-fudge)

-        (assert (not (zerop width)) t)
+        (cl-assert (not (zerop width)) t)

         (setq image-transform-rotation
               (float (round image-transform-rotation))
               image-transform-scale (/ (float length) width))
         (cons length nil))
        ((< (abs (- (mod (+ image-transform-rotation 45) 90) 45))
            image-transform-right-angle-fudge)
         (setq image-transform-rotation
               (float (round image-transform-rotation))
               image-transform-scale (/ (float length) width))
         (cons length nil))
        ((< (abs (- (mod (+ image-transform-rotation 45) 90) 45))
            image-transform-right-angle-fudge)

-        (assert (not (zerop height)) t)
+        (cl-assert (not (zerop height)) t)

         (setq image-transform-rotation
               (float (round image-transform-rotation))
               image-transform-scale (/ (float length) height))
         (cons nil length))
        (t
         (setq image-transform-rotation
               (float (round image-transform-rotation))
               image-transform-scale (/ (float length) height))
         (cons nil length))
        (t

-        (assert (not (and (zerop width) (zerop height))) t)
+        (cl-assert (not (and (zerop width) (zerop height))) t)

         (setq image-transform-scale
               (/ (float (1- length)) (image-transform-width width height)))
         ;; Assume we have a w x h image and an angle A, and let l =
         (setq image-transform-scale
               (/ (float (1- length)) (image-transform-width width height)))
         ;; 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'."
   (unless (numberp image-transform-resize)
     (let ((size (image-display-size (image-get-display-property) t)))
       (cond ((eq image-transform-resize 'fit-width)
   (unless (numberp image-transform-resize)
     (let ((size (image-display-size (image-get-display-property) t)))
       (cond ((eq image-transform-resize 'fit-width)

-            (assert (= (car size)
+            (cl-assert (= (car size)

                        (- (nth 2 (window-inside-pixel-edges))
                           (nth 0 (window-inside-pixel-edges))))
                     t))
            ((eq image-transform-resize 'fit-height)
                        (- (nth 2 (window-inside-pixel-edges))
                           (nth 0 (window-inside-pixel-edges))))
                     t))
            ((eq image-transform-resize 'fit-height)

-            (assert (= (cdr size)
+            (cl-assert (= (cdr size)

                        (- (nth 3 (window-inside-pixel-edges))
                           (nth 1 (window-inside-pixel-edges))))
                     t))))))
                        (- (nth 3 (window-inside-pixel-edges))
                           (nth 1 (window-inside-pixel-edges))))
                     t))))))

diff --git a/lisp/imenu.el b/lisp/imenu.el
index 24beb9c..8cef516 100644 (file)
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -59,7 +59,7 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))

 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;


@@ -481,7 +481,7 @@ The returned list DOES NOT share structure with LIST."
        (i 0))
     (while remain
       (push (pop remain) sublist)
        (i 0))
     (while remain
       (push (pop remain) sublist)

-      (incf i)
+      (cl-incf i)

       (and (= i n)
           ;; We have finished a sublist
           (progn (push (nreverse sublist) result)
       (and (= i n)
           ;; We have finished a sublist
           (progn (push (nreverse sublist) result)


@@ -593,17 +593,17 @@ Non-nil arguments are in recursive calls."
     t))
 
 (defun imenu--create-keymap (title alist &optional cmd)
     t))
 
 (defun imenu--create-keymap (title alist &optional cmd)

-  (list* 'keymap title
-        (mapcar
-         (lambda (item)
-           (list* (car item) (car item)
-                  (cond
-                   ((imenu--subalist-p item)
-                    (imenu--create-keymap (car item) (cdr item) cmd))
-                   (t
-                    `(lambda () (interactive)
-                       ,(if cmd `(,cmd ',item) (list 'quote item)))))))
-         alist)))
+  `(keymap ,title
+           ,@(mapcar
+              (lambda (item)
+                `(,(car item) ,(car item)
+                  ,@(cond
+                     ((imenu--subalist-p item)
+                      (imenu--create-keymap (car item) (cdr item) cmd))
+                     (t
+                      `(lambda () (interactive)
+                         ,(if cmd `(,cmd ',item) (list 'quote item)))))))
+              alist)))

 
 (defun imenu--in-alist (str alist)
   "Check whether the string STR is contained in multi-level ALIST."
 
 (defun imenu--in-alist (str alist)
   "Check whether the string STR is contained in multi-level ALIST."

diff --git a/lisp/info-xref.el b/lisp/info-xref.el
index 69ec00c..ebe5055 100644 (file)
--- a/lisp/info-xref.el
+++ b/lisp/info-xref.el
@@ -45,8 +45,7 @@
 ;;; Code:
 
 (require 'info)
 ;;; Code:
 
 (require 'info)

-(eval-when-compile
-  (require 'cl)) ;; for `incf'
+(eval-when-compile (require 'cl-lib)) ;; for `incf'

 
 ;;-----------------------------------------------------------------------------
 ;; vaguely generic
 
 ;;-----------------------------------------------------------------------------
 ;; vaguely generic


@@ -239,11 +238,11 @@ buffer's line and column of point."
 
         ;; if the file exists, try the node
         (cond ((not (cdr (assoc file info-xref-xfile-alist)))
 
         ;; if the file exists, try the node
         (cond ((not (cdr (assoc file info-xref-xfile-alist)))

-               (incf info-xref-unavail))
+               (cl-incf info-xref-unavail))

               ((info-xref-goto-node-p node)
               ((info-xref-goto-node-p node)

-               (incf info-xref-good))
+               (cl-incf info-xref-good))

               (t
               (t

-               (incf info-xref-bad)
+               (cl-incf info-xref-bad)

                (info-xref-output-error "no such node: %s" node)))))))
 
 
                (info-xref-output-error "no such node: %s" node)))))))
 
 


@@ -447,8 +446,8 @@ and can take a long time."
           (if (eq :tag (cadr link))
               (setq link (cddr link)))
           (if (info-xref-goto-node-p (cadr link))
           (if (eq :tag (cadr link))
               (setq link (cddr link)))
           (if (info-xref-goto-node-p (cadr link))

-              (incf info-xref-good)
-            (incf info-xref-bad)
+              (cl-incf info-xref-good)
+            (cl-incf info-xref-bad)

             ;; symbol-file gives nil for preloaded variables, would need
             ;; to copy what describe-variable does to show the right place
             (info-xref-output "Symbol `%s' (file %s): cannot goto node: %s"
             ;; symbol-file gives nil for preloaded variables, would need
             ;; to copy what describe-variable does to show the right place
             (info-xref-output "Symbol `%s' (file %s): cannot goto node: %s"

diff --git a/lisp/info.el b/lisp/info.el
index 0afb3f0..163e0af 100644 (file)
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -32,8 +32,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
-

 (defgroup info nil
   "Info subsystem."
   :group 'help
 (defgroup info nil
   "Info subsystem."
   :group 'help

diff --git a/lisp/international/iso-ascii.el b/lisp/international/iso-ascii.el
index 0566b8e..536cd23 100644 (file)
--- a/lisp/international/iso-ascii.el
+++ b/lisp/international/iso-ascii.el
@@ -32,7 +32,6 @@
 ;;; Code:
 
 (require 'disp-table)
 ;;; Code:
 
 (require 'disp-table)

-(eval-when-compile (require 'cl))

 
 (defgroup iso-ascii nil
   "Set up char tables for ISO 8859/1 on ASCII terminals."
 
 (defgroup iso-ascii nil
   "Set up char tables for ISO 8859/1 on ASCII terminals."


@@ -167,9 +166,14 @@
 With a prefix argument ARG, enable the mode if ARG is positive,
 and disable it otherwise.  If called from Lisp, enable the mode
 if ARG is omitted or nil."
 With a prefix argument ARG, enable the mode if ARG is positive,
 and disable it otherwise.  If called from Lisp, enable the mode
 if ARG is omitted or nil."

-  :variable (eq standard-display-table iso-ascii-display-table)
-  (unless standard-display-table
-    (setq standard-display-table iso-ascii-standard-display-table)))
+  :variable ((eq standard-display-table iso-ascii-display-table)
+             . (lambda (v)
+                 (setq standard-display-table
+                       (cond
+                        (v iso-ascii-display-table)
+                        ((eq standard-display-table iso-ascii-display-table)
+                         iso-ascii-standard-display-table)
+                        (t standard-display-table))))))

 
 (provide 'iso-ascii)
 
 
 (provide 'iso-ascii)
 

diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index 4d69e2f..fecc942 100644 (file)
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -53,7 +53,7 @@
 ;;; Code:
 
 (require 'help-mode)
 ;;; Code:
 
 (require 'help-mode)

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))

 
 (defgroup quail nil
   "Quail: multilingual input method."
 
 (defgroup quail nil
   "Quail: multilingual input method."


@@ -2395,10 +2395,10 @@ should be made by `quail-build-decode-map' (which see)."
                    (let ((last-col-elt (or (nth (1- (* (1+ col) newrows))
                                                 single-list)
                                            (car (last single-list)))))
                    (let ((last-col-elt (or (nth (1- (* (1+ col) newrows))
                                                 single-list)
                                            (car (last single-list)))))

-                     (incf width (+ (max 3 (length (car last-col-elt)))
-                                    1 single-trans-width 1))))
+                     (cl-incf width (+ (max 3 (length (car last-col-elt)))
+                                       1 single-trans-width 1))))

                  (< width window-width))
                  (< width window-width))

-          (incf cols))
+          (cl-incf cols))

         (setq rows (/ (+ len cols -1) cols)) ;Round up.
         (let ((key-width (max 3 (length (car (nth (1- rows) single-list))))))
           (insert "key")
         (setq rows (/ (+ len cols -1) cols)) ;Round up.
         (let ((key-width (max 3 (length (car (nth (1- rows) single-list))))))
           (insert "key")

diff --git a/lisp/international/ucs-normalize.el b/lisp/international/ucs-normalize.el
index cc75cc2..54566e1 100644 (file)
--- a/lisp/international/ucs-normalize.el
+++ b/lisp/international/ucs-normalize.el
@@ -109,7 +109,7 @@
 
 (defconst ucs-normalize-version "1.2")
 
 
 (defconst ucs-normalize-version "1.2")
 

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))

 
 (declare-function nfd "ucs-normalize" (char))
 
 
 (declare-function nfd "ucs-normalize" (char))
 


@@ -179,7 +179,7 @@
   (let ((char 0) ccc decomposition)
     (mapc
      (lambda (start-end)
   (let ((char 0) ccc decomposition)
     (mapc
      (lambda (start-end)

-       (do ((char (car start-end) (+ char 1))) ((> char (cdr start-end)))
+       (cl-do ((char (car start-end) (+ char 1))) ((> char (cdr start-end)))

          (setq ccc (ucs-normalize-ccc char))
          (setq decomposition (get-char-code-property
                               char 'decomposition))
          (setq ccc (ucs-normalize-ccc char))
          (setq decomposition (get-char-code-property
                               char 'decomposition))


@@ -270,7 +270,7 @@ Note that Hangul are excluded.")
     (let (decomposition alist)
       (mapc
        (lambda (start-end)
     (let (decomposition alist)
       (mapc
        (lambda (start-end)

-         (do ((char (car start-end) (+ char 1))) ((> char (cdr start-end)))
+         (cl-do ((char (car start-end) (+ char 1))) ((> char (cdr start-end)))

            (setq decomposition (funcall decomposition-function char))
            (if decomposition
                (setq alist (cons (cons char
            (setq decomposition (funcall decomposition-function char))
            (if decomposition
                (setq alist (cons (cons char


@@ -391,7 +391,7 @@ decomposition."
     (let (entries decomposition composition)
       (mapc
        (lambda (start-end)
     (let (entries decomposition composition)
       (mapc
        (lambda (start-end)

-         (do ((i (car start-end) (+ i 1))) ((> i (cdr start-end)))
+         (cl-do ((i (car start-end) (+ i 1))) ((> i (cdr start-end)))

            (setq decomposition
                  (string-to-list
                   (with-temp-buffer
            (setq decomposition
                  (string-to-list
                   (with-temp-buffer

diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index ec44b17..55e25e4 100644 (file)
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -29,8 +29,6 @@
 
 
 (eval-when-compile
 
 
 (eval-when-compile

-  (require 'cl)
-

   (defmacro with-buffer-prepared-for-jit-lock (&rest body)
     "Execute BODY in current buffer, overriding several variables.
 Preserves the `buffer-modified-p' state of the current buffer."
   (defmacro with-buffer-prepared-for-jit-lock (&rest body)
     "Execute BODY in current buffer, overriding several variables.
 Preserves the `buffer-modified-p' state of the current buffer."

diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index d509934..88aa9f5 100644 (file)
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -29,8 +29,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
-

 (defun feature-symbols (feature)
   "Return the file and list of definitions associated with FEATURE.
 The value is actually the element of `load-history'
 (defun feature-symbols (feature)
   "Return the file and list of definitions associated with FEATURE.
 The value is actually the element of `load-history'


@@ -254,11 +252,11 @@ something strange, such as redefining an Emacs function."
 
       (dolist (x unload-function-defs-list)
        (if (consp x)
 
       (dolist (x unload-function-defs-list)
        (if (consp x)

-           (case (car x)
+           (pcase (car x)

              ;; Remove any feature names that this file provided.
              ;; Remove any feature names that this file provided.

-             (provide
+             (`provide

               (setq features (delq (cdr x) features)))
               (setq features (delq (cdr x) features)))

-             ((defun autoload)
+             ((or `defun `autoload)

               (let ((fun (cdr x)))
                 (when (fboundp fun)
                   (when (fboundp 'ad-unadvise)
               (let ((fun (cdr x)))
                 (when (fboundp fun)
                   (when (fboundp 'ad-unadvise)


@@ -270,9 +268,9 @@ something strange, such as redefining an Emacs function."
              ;; (t . SYMBOL) comes before (defun . SYMBOL)
              ;; and says we should restore SYMBOL's autoload
              ;; when we undefine it.
              ;; (t . SYMBOL) comes before (defun . SYMBOL)
              ;; and says we should restore SYMBOL's autoload
              ;; when we undefine it.

-             ((t) (setq restore-autoload (cdr x)))
-             ((require defface) nil)
-             (t (message "Unexpected element %s in load-history" x)))
+             (`t (setq restore-autoload (cdr x)))
+             ((or `require `defface) nil)
+             (_ (message "Unexpected element %s in load-history" x)))

          ;; Kill local values as much as possible.
          (dolist (buf (buffer-list))
            (with-current-buffer buf
          ;; Kill local values as much as possible.
          (dolist (buf (buffer-list))
            (with-current-buffer buf

diff --git a/lisp/lpr.el b/lisp/lpr.el
index 65295a7..b31d19b 100644 (file)
--- a/lisp/lpr.el
+++ b/lisp/lpr.el
@@ -29,8 +29,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
-

 ;;;###autoload
 (defvar lpr-windows-system
   (memq system-type '(ms-dos windows-nt))
 ;;;###autoload
 (defvar lpr-windows-system
   (memq system-type '(ms-dos windows-nt))


@@ -281,10 +279,10 @@ for further customization of the printer command."
           (if (markerp end)
               (set-marker end nil))
           (message "Spooling%s...done%s%s" switch-string
           (if (markerp end)
               (set-marker end nil))
           (message "Spooling%s...done%s%s" switch-string

-                   (case (count-lines (point-min) (point-max))
+                   (pcase (count-lines (point-min) (point-max))

                      (0 "")
                      (1 ": ")
                      (0 "")
                      (1 ": ")

-                     (t ":\n"))
+                     (_ ":\n"))

                    (buffer-string)))))))
 
 ;; This function copies the text between start and end
                    (buffer-string)))))))
 
 ;; This function copies the text between start and end

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index e20106e..5c2c14d 100644 (file)
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -81,7 +81,7 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))

 
 ;;; Completion table manipulation
 
 
 ;;; Completion table manipulation
 


@@ -224,10 +224,10 @@ the form (concat S2 S)."
         (cond
          ((eq (car-safe action) 'boundaries)
           (let ((beg (or (and (eq (car-safe res) 'boundaries) (cadr res)) 0)))
         (cond
          ((eq (car-safe action) 'boundaries)
           (let ((beg (or (and (eq (car-safe res) 'boundaries) (cadr res)) 0)))

-            (list* 'boundaries
-                   (max (length s1)
-                        (+ beg (- (length s1) (length s2))))
-                   (and (eq (car-safe res) 'boundaries) (cddr res)))))
+            `(boundaries
+              ,(max (length s1)
+                    (+ beg (- (length s1) (length s2))))
+              . ,(and (eq (car-safe res) 'boundaries) (cddr res)))))

          ((stringp res)
           (if (eq t (compare-strings res 0 (length s2) s2 nil nil
                                      completion-ignore-case))
          ((stringp res)
           (if (eq t (compare-strings res 0 (length s2) s2 nil nil
                                      completion-ignore-case))


@@ -267,7 +267,7 @@ the form (concat S2 S)."
     (if (eq (car-safe action) 'boundaries)
         (let* ((len (length prefix))
                (bound (completion-boundaries string table pred (cdr action))))
     (if (eq (car-safe action) 'boundaries)
         (let* ((len (length prefix))
                (bound (completion-boundaries string table pred (cdr action))))

-          (list* 'boundaries (+ (car bound) len) (cdr bound)))
+          `(boundaries ,(+ (car bound) len) . ,(cdr bound)))

       (let ((comp (complete-with-action action table string pred)))
         (cond
          ;; In case of try-completion, add the prefix.
       (let ((comp (complete-with-action action table string pred)))
         (cond
          ;; 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
                                   (cdr terminator) (regexp-quote terminator)))
            (max (and terminator-regexp
                      (string-match terminator-regexp suffix))))
                                   (cdr terminator) (regexp-quote terminator)))
            (max (and terminator-regexp
                      (string-match terminator-regexp suffix))))

-      (list* 'boundaries (car bounds)
-             (min (cdr bounds) (or max (length suffix))))))
+      `(boundaries ,(car bounds)
+                   . ,(min (cdr bounds) (or max (length suffix))))))

    ((eq action nil)
     (let ((comp (try-completion string table pred)))
       (if (consp terminator) (setq terminator (car terminator)))
    ((eq action nil)
     (let ((comp (try-completion string table pred)))
       (if (consp terminator) (setq terminator (car terminator)))


@@ -408,7 +408,7 @@ for use at QPOS."
              (qsuffix (cdr action))
              (ufull (if (zerop (length qsuffix)) ustring
                       (funcall unquote (concat string qsuffix))))
              (qsuffix (cdr action))
              (ufull (if (zerop (length qsuffix)) ustring
                       (funcall unquote (concat string qsuffix))))

-             (_ (assert (string-prefix-p ustring ufull)))
+             (_ (cl-assert (string-prefix-p ustring ufull)))

              (usuffix (substring ufull (length ustring)))
              (boundaries (completion-boundaries ustring table pred usuffix))
              (qlboundary (car (funcall requote (car boundaries) string)))
              (usuffix (substring ufull (length ustring)))
              (boundaries (completion-boundaries ustring table pred usuffix))
              (qlboundary (car (funcall requote (car boundaries) string)))


@@ -418,7 +418,7 @@ for use at QPOS."
                              (- (car (funcall requote urfullboundary
                                               (concat string qsuffix)))
                                 (length string))))))
                              (- (car (funcall requote urfullboundary
                                               (concat string qsuffix)))
                                 (length string))))))

-        (list* 'boundaries qlboundary qrboundary)))
+        `(boundaries ,qlboundary . ,qrboundary)))

 
      ;; In "normal" use a c-t-with-quoting completion table should never be
      ;; called with action in (t nil) because `completion--unquote' should have
 
      ;; In "normal" use a c-t-with-quoting completion table should never be
      ;; called with action in (t nil) because `completion--unquote' should have


@@ -466,18 +466,18 @@ for use at QPOS."
       (let ((ustring (funcall unquote string))
             (uprefix (funcall unquote (substring string 0 pred))))
         ;; We presume (more or less) that `concat' and `unquote' commute.
       (let ((ustring (funcall unquote string))
             (uprefix (funcall unquote (substring string 0 pred))))
         ;; We presume (more or less) that `concat' and `unquote' commute.

-        (assert (string-prefix-p uprefix ustring))
+        (cl-assert (string-prefix-p uprefix ustring))

         (list ustring table (length uprefix)
               (lambda (unquoted-result op)
                 (pcase op
         (list ustring table (length uprefix)
               (lambda (unquoted-result op)
                 (pcase op

-                  (`1 ;;try
+                  (1 ;;try

                    (if (not (stringp (car-safe unquoted-result)))
                        unquoted-result
                      (completion--twq-try
                       string ustring
                       (car unquoted-result) (cdr unquoted-result)
                       unquote requote)))
                    (if (not (stringp (car-safe unquoted-result)))
                        unquoted-result
                      (completion--twq-try
                       string ustring
                       (car unquoted-result) (cdr unquoted-result)
                       unquote requote)))

-                  (`2 ;;all
+                  (2 ;;all

                    (let* ((last (last unquoted-result))
                           (base (or (cdr last) 0)))
                      (when last
                    (let* ((last (last unquoted-result))
                           (base (or (cdr last) 0)))
                      (when last


@@ -527,12 +527,12 @@ for use at QPOS."
          (`(,qfullpos . ,qfun)
           (funcall requote (+ boundary (length prefix)) string))
          (qfullprefix (substring string 0 qfullpos))
          (`(,qfullpos . ,qfun)
           (funcall requote (+ boundary (length prefix)) string))
          (qfullprefix (substring string 0 qfullpos))

-         (_ (assert (completion--string-equal-p
-                    (funcall unquote qfullprefix)
-                    (concat (substring ustring 0 boundary) prefix))
-                   t))
+         (_ (cl-assert (completion--string-equal-p
+                        (funcall unquote qfullprefix)
+                        (concat (substring ustring 0 boundary) prefix))
+                       t))

          (qboundary (car (funcall requote boundary string)))
          (qboundary (car (funcall requote boundary string)))

-         (_ (assert (<= qboundary qfullpos)))
+         (_ (cl-assert (<= qboundary qfullpos)))

          ;; FIXME: this split/quote/concat business messes up the carefully
          ;; placed completions-common-part and completions-first-difference
          ;; faces.  We could try within the mapcar loop to search for the
          ;; FIXME: this split/quote/concat business messes up the carefully
          ;; placed completions-common-part and completions-first-difference
          ;; faces.  We could try within the mapcar loop to search for the


@@ -555,11 +555,11 @@ for use at QPOS."
       ;; which only get quoted when needed by choose-completion.
       (nconc
        (mapcar (lambda (completion)
       ;; which only get quoted when needed by choose-completion.
       (nconc
        (mapcar (lambda (completion)

-                 (assert (string-prefix-p prefix completion 'ignore-case) t)
+                 (cl-assert (string-prefix-p prefix completion 'ignore-case) t)

                  (let* ((new (substring completion (length prefix)))
                         (qnew (funcall qfun new))
                         (qcompletion (concat qprefix qnew)))
                  (let* ((new (substring completion (length prefix)))
                         (qnew (funcall qfun new))
                         (qcompletion (concat qprefix qnew)))

-                   (assert
+                   (cl-assert

                     (completion--string-equal-p
                     (funcall unquote
                              (concat (substring string 0 qboundary)
                     (completion--string-equal-p
                     (funcall unquote
                              (concat (substring string 0 qboundary)


@@ -994,9 +994,9 @@ when the buffer's text is already an exact match."
                                         'exact 'unknown))))
              ;; Show the completion table, if requested.
              ((not exact)
                                         'exact 'unknown))))
              ;; Show the completion table, if requested.
              ((not exact)

-             (if (case completion-auto-help
-                    (lazy (eq this-command last-command))
-                    (t completion-auto-help))
+             (if (pcase completion-auto-help
+                    (`lazy (eq this-command last-command))
+                    (_ completion-auto-help))

                   (minibuffer-completion-help)
                 (completion--message "Next char not unique")))
              ;; If the last exact completion and this one were the same, it
                   (minibuffer-completion-help)
                 (completion--message "Next char not unique")))
              ;; If the last exact completion and this one were the same, it


@@ -1041,9 +1041,9 @@ scroll the window of possible completions."
    ((and completion-cycling completion-all-sorted-completions)
     (minibuffer-force-complete)
     t)
    ((and completion-cycling completion-all-sorted-completions)
     (minibuffer-force-complete)
     t)

-   (t (case (completion--do-completion)
+   (t (pcase (completion--do-completion)

         (#b000 nil)
         (#b000 nil)

-        (t     t)))))
+        (_     t)))))

 
 (defun completion--cache-all-sorted-completions (comps)
   (add-hook 'after-change-functions
 
 (defun completion--cache-all-sorted-completions (comps)
   (add-hook 'after-change-functions


@@ -1203,15 +1203,15 @@ If `minibuffer-completion-confirm' is `confirm-after-completion',
 
      (t
       ;; Call do-completion, but ignore errors.
 
      (t
       ;; Call do-completion, but ignore errors.

-      (case (condition-case nil
+      (pcase (condition-case nil

                 (completion--do-completion nil 'expect-exact)
               (error 1))
                 (completion--do-completion nil 'expect-exact)
               (error 1))

-        ((#b001 #b011) (exit-minibuffer))
+        ((or #b001 #b011) (exit-minibuffer))

         (#b111 (if (not minibuffer-completion-confirm)
                    (exit-minibuffer)
                  (minibuffer-message "Confirm")
                  nil))
         (#b111 (if (not minibuffer-completion-confirm)
                    (exit-minibuffer)
                  (minibuffer-message "Confirm")
                  nil))

-        (t nil))))))
+        (_ nil))))))

 
 (defun completion--try-word-completion (string table predicate point md)
   (let ((comp (completion-try-completion string table predicate point md)))
 
 (defun completion--try-word-completion (string table predicate point md)
   (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
 is added, provided that matches some possible completion.
 Return nil if there is no valid completion, else t."
   (interactive)
 is added, provided that matches some possible completion.
 Return nil if there is no valid completion, else t."
   (interactive)

-  (case (completion--do-completion 'completion--try-word-completion)
+  (pcase (completion--do-completion 'completion--try-word-completion)

     (#b000 nil)
     (#b000 nil)

-    (t     t)))
+    (_     t)))

 
 (defface completions-annotations '((t :inherit italic))
   "Face to use for annotations in the *Completions* buffer.")
 
 (defface completions-annotations '((t :inherit italic))
   "Face to use for annotations in the *Completions* buffer.")


@@ -1555,7 +1555,7 @@ variables.")
 (defun completion--done (string &optional finished message)
   (let* ((exit-fun (plist-get completion-extra-properties :exit-function))
          (pre-msg (and exit-fun (current-message))))
 (defun completion--done (string &optional finished message)
   (let* ((exit-fun (plist-get completion-extra-properties :exit-function))
          (pre-msg (and exit-fun (current-message))))

-    (assert (memq finished '(exact sole finished unknown)))
+    (cl-assert (memq finished '(exact sole finished unknown)))

     ;; FIXME: exit-fun should receive `finished' as a parameter.
     (when exit-fun
       (when (eq finished 'unknown)
     ;; FIXME: exit-fun should receive `finished' as a parameter.
     (when exit-fun
       (when (eq finished 'unknown)


@@ -1727,7 +1727,7 @@ Return nil if there is no valid completion, else t.
 Point needs to be somewhere between START and END.
 PREDICATE (a function called with no arguments) says when to
 exit."
 Point needs to be somewhere between START and END.
 PREDICATE (a function called with no arguments) says when to
 exit."

-  (assert (<= start (point)) (<= (point) end))
+  (cl-assert (<= start (point)) (<= (point) end))

   (with-wrapper-hook
       ;; FIXME: Maybe we should use this hook to provide a "display
       ;; completions" operation as well.
   (with-wrapper-hook
       ;; FIXME: Maybe we should use this hook to provide a "display
       ;; completions" operation as well.


@@ -1794,7 +1794,7 @@ the mode if ARG is omitted or nil."
       (unless (equal "*Completions*" (buffer-name (window-buffer)))
        (minibuffer-hide-completions))
     ;; (add-hook 'pre-command-hook #'completion-in-region--prech)
       (unless (equal "*Completions*" (buffer-name (window-buffer)))
        (minibuffer-hide-completions))
     ;; (add-hook 'pre-command-hook #'completion-in-region--prech)

-    (assert completion-in-region-mode-predicate)
+    (cl-assert completion-in-region-mode-predicate)

     (setq completion-in-region-mode--predicate
          completion-in-region-mode-predicate)
     (add-hook 'post-command-hook #'completion-in-region--postch)
     (setq completion-in-region-mode--predicate
          completion-in-region-mode-predicate)
     (add-hook 'post-command-hook #'completion-in-region--postch)


@@ -1837,10 +1837,10 @@ a completion function or god knows what else.")
   ;; always return the same kind of data, but this breaks down with functions
   ;; like comint-completion-at-point or mh-letter-completion-at-point, which
   ;; could be sometimes safe and sometimes misbehaving (and sometimes neither).
   ;; always return the same kind of data, but this breaks down with functions
   ;; like comint-completion-at-point or mh-letter-completion-at-point, which
   ;; could be sometimes safe and sometimes misbehaving (and sometimes neither).

-  (if (case which
-        (all t)
-        (safe (member fun completion--capf-safe-funs))
-        (optimist (not (member fun completion--capf-misbehave-funs))))
+  (if (pcase which
+        (`all t)
+        (`safe (member fun completion--capf-safe-funs))
+        (`optimist (not (member fun completion--capf-misbehave-funs))))

       (let ((res (funcall fun)))
         (cond
          ((and (consp res) (not (functionp res)))
       (let ((res (funcall fun)))
         (cond
          ((and (consp res) (not (functionp res)))


@@ -2046,10 +2046,10 @@ same as `substitute-in-file-name'."
           (if (eq action 'metadata)
               '(metadata (category . environment-variable))
             (let ((suffix (cdr action)))
           (if (eq action 'metadata)
               '(metadata (category . environment-variable))
             (let ((suffix (cdr action)))

-              (list* 'boundaries
-                     (or (match-beginning 2) (match-beginning 1))
-                     (when (string-match "[^[:alnum:]_]" suffix)
-                       (match-beginning 0)))))))
+              `(boundaries
+                ,(or (match-beginning 2) (match-beginning 1))
+                . ,(when (string-match "[^[:alnum:]_]" suffix)
+                     (match-beginning 0)))))))

        (t
         (if (eq (aref string (1- beg)) ?{)
             (setq table (apply-partially 'completion-table-with-terminator
        (t
         (if (eq (aref string (1- beg)) ?{)
             (setq table (apply-partially 'completion-table-with-terminator


@@ -2074,14 +2074,14 @@ same as `substitute-in-file-name'."
        ((eq (car-safe action) 'boundaries)
         (let ((start (length (file-name-directory string)))
               (end (string-match-p "/" (cdr action))))
        ((eq (car-safe action) 'boundaries)
         (let ((start (length (file-name-directory string)))
               (end (string-match-p "/" (cdr action))))

-          (list* 'boundaries
-                 ;; if `string' is "C:" in w32, (file-name-directory string)
-                 ;; returns "C:/", so `start' is 3 rather than 2.
-                 ;; Not quite sure what is The Right Fix, but clipping it
-                 ;; back to 2 will work for this particular case.  We'll
-                 ;; see if we can come up with a better fix when we bump
-                 ;; into more such problematic cases.
-                 (min start (length string)) end)))
+          `(boundaries
+            ;; if `string' is "C:" in w32, (file-name-directory string)
+            ;; returns "C:/", so `start' is 3 rather than 2.
+            ;; Not quite sure what is The Right Fix, but clipping it
+            ;; back to 2 will work for this particular case.  We'll
+            ;; see if we can come up with a better fix when we bump
+            ;; into more such problematic cases.
+            ,(min start (length string)) . ,end)))

 
        ((eq action 'lambda)
         (if (zerop (length string))
 
        ((eq action 'lambda)
         (if (zerop (length string))


@@ -2663,7 +2663,7 @@ or a symbol, see `completion-pcm--merge-completions'."
               (setq p0 (1+ p)))
           (push 'any pattern)
           (setq p0 p))
               (setq p0 (1+ p)))
           (push 'any pattern)
           (setq p0 p))

-        (incf p))
+        (cl-incf p))

 
       ;; An empty string might be erroneously added at the beginning.
       ;; It should be avoided properly, but it's so easy to remove it here.
 
       ;; An empty string might be erroneously added at the beginning.
       ;; 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'."
 (defun completion-pcm--all-completions (prefix pattern table pred)
   "Find all completions for PATTERN in TABLE obeying PRED.
 PATTERN is as returned by `completion-pcm--string->pattern'."
 (defun completion-pcm--all-completions (prefix pattern table pred)
   "Find all completions for PATTERN in TABLE obeying PRED.
 PATTERN is as returned by `completion-pcm--string->pattern'."

-  ;; (assert (= (car (completion-boundaries prefix table pred ""))
+  ;; (cl-assert (= (car (completion-boundaries prefix table pred ""))

   ;;            (length prefix)))
   ;; Find an initial list of possible completions.
   (if (completion-pcm--pattern-trivial-p pattern)
   ;;            (length prefix)))
   ;; Find an initial list of possible completions.
   (if (completion-pcm--pattern-trivial-p pattern)


@@ -2762,9 +2762,9 @@ filter out additional entries (because TABLE might not obey PRED)."
         ;; The prefix has no completions at all, so we should try and fix
         ;; that first.
         (let ((substring (substring prefix 0 -1)))
         ;; The prefix has no completions at all, so we should try and fix
         ;; that first.
         (let ((substring (substring prefix 0 -1)))

-          (destructuring-bind (subpat suball subprefix _subsuffix)
-              (completion-pcm--find-all-completions
-               substring table pred (length substring) filter)
+          (pcase-let ((`(,subpat ,suball ,subprefix ,_subsuffix)
+                       (completion-pcm--find-all-completions
+                        substring table pred (length substring) filter)))

             (let ((sep (aref prefix (1- (length prefix))))
                   ;; Text that goes between the new submatches and the
                   ;; completion substring.
             (let ((sep (aref prefix (1- (length prefix))))
                   ;; Text that goes between the new submatches and the
                   ;; completion substring.


@@ -2828,8 +2828,8 @@ filter out additional entries (because TABLE might not obey PRED)."
         (list pattern all prefix suffix)))))
 
 (defun completion-pcm-all-completions (string table pred point)
         (list pattern all prefix suffix)))))
 
 (defun completion-pcm-all-completions (string table pred point)

-  (destructuring-bind (pattern all &optional prefix _suffix)
-      (completion-pcm--find-all-completions string table pred point)
+  (pcase-let ((`(,pattern ,all ,prefix ,_suffix)
+               (completion-pcm--find-all-completions string table pred point)))

     (when all
       (nconc (completion-pcm--hilit-commonality pattern all)
              (length prefix)))))
     (when all
       (nconc (completion-pcm--hilit-commonality pattern all)
              (length prefix)))))


@@ -2928,7 +2928,7 @@ the same set of elements."
                     ;; `any' it could lead to a merged completion that
                     ;; doesn't itself match the candidates.
                     (let ((suffix (completion--common-suffix comps)))
                     ;; `any' it could lead to a merged completion that
                     ;; doesn't itself match the candidates.
                     (let ((suffix (completion--common-suffix comps)))

-                      (assert (stringp suffix))
+                      (cl-assert (stringp suffix))

                       (unless (equal suffix "")
                         (push suffix res)))))
                 (setq fixed "")))))
                       (unless (equal suffix "")
                         (push suffix res)))))
                 (setq fixed "")))))


@@ -2992,11 +2992,11 @@ the same set of elements."
       (cons (concat prefix merged suffix) (+ newpos (length prefix)))))))
 
 (defun completion-pcm-try-completion (string table pred point)
       (cons (concat prefix merged suffix) (+ newpos (length prefix)))))))
 
 (defun completion-pcm-try-completion (string table pred point)

-  (destructuring-bind (pattern all prefix suffix)
-      (completion-pcm--find-all-completions
-       string table pred point
-       (if minibuffer-completing-file-name
-           'completion-pcm--filename-try-filter))
+  (pcase-let ((`(,pattern ,all ,prefix ,suffix)
+               (completion-pcm--find-all-completions
+                string table pred point
+                (if minibuffer-completing-file-name
+                    'completion-pcm--filename-try-filter))))

     (completion-pcm--merge-try pattern all prefix suffix)))
 
 ;;; Substring completion
     (completion-pcm--merge-try pattern all prefix suffix)))
 
 ;;; Substring completion


@@ -3017,15 +3017,17 @@ the same set of elements."
     (list all pattern prefix suffix (car bounds))))
 
 (defun completion-substring-try-completion (string table pred point)
     (list all pattern prefix suffix (car bounds))))
 
 (defun completion-substring-try-completion (string table pred point)

-  (destructuring-bind (all pattern prefix suffix _carbounds)
-      (completion-substring--all-completions string table pred point)
+  (pcase-let ((`(,all ,pattern ,prefix ,suffix ,_carbounds)
+               (completion-substring--all-completions
+                string table pred point)))

     (if minibuffer-completing-file-name
         (setq all (completion-pcm--filename-try-filter all)))
     (completion-pcm--merge-try pattern all prefix suffix)))
 
 (defun completion-substring-all-completions (string table pred point)
     (if minibuffer-completing-file-name
         (setq all (completion-pcm--filename-try-filter all)))
     (completion-pcm--merge-try pattern all prefix suffix)))
 
 (defun completion-substring-all-completions (string table pred point)

-  (destructuring-bind (all pattern prefix _suffix _carbounds)
-      (completion-substring--all-completions string table pred point)
+  (pcase-let ((`(,all ,pattern ,prefix ,_suffix ,_carbounds)
+               (completion-substring--all-completions
+                string table pred point)))

     (when all
       (nconc (completion-pcm--hilit-commonality pattern all)
              (length prefix)))))
     (when all
       (nconc (completion-pcm--hilit-commonality pattern all)
              (length prefix)))))

diff --git a/lisp/mpc.el b/lisp/mpc.el
index a908e4b..ff5ce80 100644 (file)
--- a/lisp/mpc.el
+++ b/lisp/mpc.el
@@ -92,7 +92,7 @@
 ;; UI-commands       : mpc-
 ;; internal          : mpc--
 
 ;; UI-commands       : mpc-
 ;; internal          : mpc--
 

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))

 
 (defgroup mpc ()
   "Client for the Music Player Daemon (mpd)."
 
 (defgroup mpc ()
   "Client for the Music Player Daemon (mpd)."


@@ -292,7 +292,7 @@ and HOST defaults to localhost."
 (defconst mpc--proc-alist-to-alists-starters '(file directory))
 
 (defun mpc--proc-alist-to-alists (alist)
 (defconst mpc--proc-alist-to-alists-starters '(file directory))
 
 (defun mpc--proc-alist-to-alists (alist)

-  (assert (or (null alist)
+  (cl-assert (or (null alist)

               (memq (caar alist) mpc--proc-alist-to-alists-starters)))
   (let ((starter (caar alist))
         (alists ())
               (memq (caar alist) mpc--proc-alist-to-alists-starters)))
   (let ((starter (caar alist))
         (alists ())


@@ -457,7 +457,7 @@ to call FUN for any change whatsoever.")
   (let ((old-status mpc-status))
     ;; Update the alist.
     (setq mpc-status (mpc-proc-buf-to-alist))
   (let ((old-status mpc-status))
     ;; Update the alist.
     (setq mpc-status (mpc-proc-buf-to-alist))

-    (assert mpc-status)
+    (cl-assert mpc-status)

     (unless (equal old-status mpc-status)
       ;; Run the relevant refresher functions.
       (dolist (pair mpc-status-callbacks)
     (unless (equal old-status mpc-status)
       ;; Run the relevant refresher functions.
       (dolist (pair mpc-status-callbacks)


@@ -544,7 +544,7 @@ Any call to `mpc-status-refresh' may cause it to be restarted."
 ;; (defun mpc--queue-pop ()
 ;;   (when mpc-queue                       ;Can be nil if out of sync.
 ;;     (let ((song (car mpc-queue)))
 ;; (defun mpc--queue-pop ()
 ;;   (when mpc-queue                       ;Can be nil if out of sync.
 ;;     (let ((song (car mpc-queue)))

-;;       (assert song)
+;;       (cl-assert song)

 ;;       (push (if (and (consp song) (cddr song))
 ;;                 ;; The queue's first element is itself a list of
 ;;                 ;; songs, where the first element isn't itself a song
 ;;       (push (if (and (consp song) (cddr song))
 ;;                 ;; The queue's first element is itself a list of
 ;;                 ;; 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."
 ;;               (prog1 (if (consp song) (cadr song) song)
 ;;                 (setq mpc-queue (cdr mpc-queue))))
 ;;             mpc-queue-back)
 ;;               (prog1 (if (consp song) (cadr song) song)
 ;;                 (setq mpc-queue (cdr mpc-queue))))
 ;;             mpc-queue-back)

-;;       (assert (stringp (car mpc-queue-back))))))
+;;       (cl-assert (stringp (car mpc-queue-back))))))

 
 ;; (defun mpc--queue-refresh ()
 ;;   ;; Maintain the queue.
 
 ;; (defun mpc--queue-refresh ()
 ;;   ;; Maintain the queue.


@@ -611,7 +611,7 @@ The songs are returned as alists."
                        (i 0))
                    (mapcar (lambda (s)
                              (prog1 (cons (cons 'Pos (number-to-string i)) s)
                        (i 0))
                    (mapcar (lambda (s)
                              (prog1 (cons (cons 'Pos (number-to-string i)) s)

-                               (incf i)))
+                               (cl-incf i)))

                            l)))
                 ((eq tag 'Search)
                  (mpc-proc-buf-to-alists
                            l)))
                 ((eq tag 'Search)
                  (mpc-proc-buf-to-alists


@@ -827,8 +827,8 @@ If PLAYLIST is t or nil or missing, use the main playlist."
                          (list "move" song-pos dest-pos))
                   (if (< song-pos dest-pos)
                       ;; This move has shifted dest-pos by 1.
                          (list "move" song-pos dest-pos))
                   (if (< song-pos dest-pos)
                       ;; This move has shifted dest-pos by 1.

-                      (decf dest-pos))
-                  (incf i)))
+                      (cl-decf dest-pos))
+                  (cl-incf i)))

               ;; Sort them from last to first, so the renumbering
               ;; caused by the earlier deletions affect
               ;; later ones a bit less.
               ;; Sort them from last to first, so the renumbering
               ;; caused by the earlier deletions affect
               ;; later ones a bit less.


@@ -972,8 +972,8 @@ If PLAYLIST is t or nil or missing, use the main playlist."
                (right-align (match-end 1))
                (text
                 (if (eq info 'self) (symbol-name tag)
                (right-align (match-end 1))
                (text
                 (if (eq info 'self) (symbol-name tag)

-                  (case tag
-                    ((Time Duration)
+                  (pcase tag
+                    ((or `Time `Duration)

                      (let ((time (cdr (or (assq 'time info) (assq 'Time info)))))
                        (setq pred (list nil)) ;Just assume it's never eq.
                        (when time
                      (let ((time (cdr (or (assq 'time info) (assq 'Time info)))))
                        (setq pred (list nil)) ;Just assume it's never eq.
                        (when time


@@ -981,7 +981,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
                                                     (string-match ":" time))
                                                (substring time (match-end 0))
                                              time)))))
                                                     (string-match ":" time))
                                                (substring time (match-end 0))
                                              time)))))

-                    (Cover
+                    (`Cover

                      (let* ((dir (file-name-directory (cdr (assq 'file info))))
                             (cover (concat dir "cover.jpg"))
                             (file (condition-case err
                      (let* ((dir (file-name-directory (cdr (assq 'file info))))
                             (cover (concat dir "cover.jpg"))
                             (file (condition-case err


@@ -1004,7 +1004,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
                              (mpc-tempfiles-add image tempfile)))
                          (setq size nil)
                          (propertize dir 'display image))))
                              (mpc-tempfiles-add image tempfile)))
                          (setq size nil)
                          (propertize dir 'display image))))

-                    (t (let ((val (cdr (assq tag info))))
+                    (_ (let ((val (cdr (assq tag info))))

                          ;; For Streaming URLs, there's no other info
                          ;; than the URL in `file'.  Pretend it's in `Title'.
                          (when (and (null val) (eq tag 'Title))
                          ;; For Streaming URLs, there's no other info
                          ;; than the URL in `file'.  Pretend it's in `Title'.
                          (when (and (null val) (eq tag 'Title))


@@ -1222,7 +1222,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
   (beginning-of-line))
 
 (defun mpc-select-make-overlay ()
   (beginning-of-line))
 
 (defun mpc-select-make-overlay ()

-  (assert (not (get-char-property (point) 'mpc-select)))
+  (cl-assert (not (get-char-property (point) 'mpc-select)))

   (let ((ol (make-overlay
              (line-beginning-position) (line-beginning-position 2))))
     (overlay-put ol 'mpc-select t)
   (let ((ol (make-overlay
              (line-beginning-position) (line-beginning-position 2))))
     (overlay-put ol 'mpc-select t)


@@ -1258,7 +1258,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
                    (> (overlay-end ol) (point)))
               (delete-overlay ol)
             (push ol ols)))
                    (> (overlay-end ol) (point)))
               (delete-overlay ol)
             (push ol ols)))

-        (assert (= (1+ (length ols)) (length mpc-select)))
+        (cl-assert (= (1+ (length ols)) (length mpc-select)))

         (setq mpc-select ols)))
      ;; We're trying to select *ALL* additionally to others.
      ((mpc-tagbrowser-all-p) nil)
         (setq mpc-select ols)))
      ;; We're trying to select *ALL* additionally to others.
      ((mpc-tagbrowser-all-p) nil)


@@ -1286,12 +1286,12 @@ If PLAYLIST is t or nil or missing, use the main playlist."
           (while (and (zerop (forward-line 1))
                       (get-char-property (point) 'mpc-select))
             (setq end (1+ (point)))
           (while (and (zerop (forward-line 1))
                       (get-char-property (point) 'mpc-select))
             (setq end (1+ (point)))

-            (incf after))
+            (cl-incf after))

           (goto-char mid)
           (while (and (zerop (forward-line -1))
                       (get-char-property (point) 'mpc-select))
             (setq start (point))
           (goto-char mid)
           (while (and (zerop (forward-line -1))
                       (get-char-property (point) 'mpc-select))
             (setq start (point))

-            (incf before))
+            (cl-incf before))

           (if (and (= after 0) (= before 0))
               ;; Shortening an already minimum-size region: do nothing.
               nil
           (if (and (= after 0) (= before 0))
               ;; Shortening an already minimum-size region: do nothing.
               nil


@@ -1315,13 +1315,13 @@ If PLAYLIST is t or nil or missing, use the main playlist."
               (start (line-beginning-position)))
           (while (and (zerop (forward-line 1))
                       (not (get-char-property (point) 'mpc-select)))
               (start (line-beginning-position)))
           (while (and (zerop (forward-line 1))
                       (not (get-char-property (point) 'mpc-select)))

-            (incf count))
+            (cl-incf count))

           (unless (get-char-property (point) 'mpc-select)
             (setq count nil))
           (goto-char start)
           (while (and (zerop (forward-line -1))
                       (not (get-char-property (point) 'mpc-select)))
           (unless (get-char-property (point) 'mpc-select)
             (setq count nil))
           (goto-char start)
           (while (and (zerop (forward-line -1))
                       (not (get-char-property (point) 'mpc-select)))

-            (incf before))
+            (cl-incf before))

           (unless (get-char-property (point) 'mpc-select)
             (setq before nil))
           (when (and before (or (null count) (< before count)))
           (unless (get-char-property (point) 'mpc-select)
             (setq before nil))
           (when (and before (or (null count) (< before count)))


@@ -1430,7 +1430,7 @@ when constructing the set of constraints."
   (mpc-select-save
     (widen)
     (goto-char (point-min))
   (mpc-select-save
     (widen)
     (goto-char (point-min))

-    (assert (looking-at (regexp-quote mpc-tagbrowser-all-name)))
+    (cl-assert (looking-at (regexp-quote mpc-tagbrowser-all-name)))

     (forward-line 1)
     (let ((inhibit-read-only t))
       (delete-region (point) (point-max))
     (forward-line 1)
     (let ((inhibit-read-only t))
       (delete-region (point) (point-max))


@@ -1916,7 +1916,7 @@ This is used so that they can be compared with `eq', which is needed for
                                                 (cdr (assq 'file song1))
                                                 (cdr (assq 'file song2)))))
                                       (and (integerp cmp) (< cmp 0)))))))
                                                 (cdr (assq 'file song1))
                                                 (cdr (assq 'file song2)))))
                                       (and (integerp cmp) (< cmp 0)))))))

-              (incf totaltime (string-to-number (or (cdr (assq 'Time song)) "0")))
+              (cl-incf totaltime (string-to-number (or (cdr (assq 'Time song)) "0")))

               (mpc-format mpc-songs-format song)
               (delete-char (- (skip-chars-backward " "))) ;Remove trailing space.
               (insert "\n")
               (mpc-format mpc-songs-format song)
               (delete-char (- (skip-chars-backward " "))) ;Remove trailing space.
               (insert "\n")


@@ -2040,7 +2040,7 @@ This is used so that they can be compared with `eq', which is needed for
                                        (- (point) (car prev)))
                                     next prev)
                               (or next prev)))))
                                        (- (point) (car prev)))
                                     next prev)
                               (or next prev)))))

-              (assert sn)
+              (cl-assert sn)

               (mpc-proc-cmd (concat "play " sn))))))))))
 
 (define-derived-mode mpc-songs-mode mpc-mode "MPC-song"
               (mpc-proc-cmd (concat "play " sn))))))))))
 
 (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
     (dolist (song (car context))
       (and (zerop (forward-line -1))
            (eq (get-text-property (point) 'mpc-file) song)
     (dolist (song (car context))
       (and (zerop (forward-line -1))
            (eq (get-text-property (point) 'mpc-file) song)

-           (incf count)))
+           (cl-incf count)))

     (goto-char pos)
     (dolist (song (cdr context))
       (and (zerop (forward-line 1))
            (eq (get-text-property (point) 'mpc-file) song)
     (goto-char pos)
     (dolist (song (cdr context))
       (and (zerop (forward-line 1))
            (eq (get-text-property (point) 'mpc-file) song)

-           (incf count)))
+           (cl-incf count)))

     count))
 
 (defun mpc-songpointer-refresh-hairy ()
     count))
 
 (defun mpc-songpointer-refresh-hairy ()


@@ -2201,13 +2201,13 @@ This is used so that they can be compared with `eq', which is needed for
                ((< score context-size) nil)
                (t
                 ;; Score is equal and increasing context might help: try it.
                ((< score context-size) nil)
                (t
                 ;; Score is equal and increasing context might help: try it.

-                (incf context-size)
+                (cl-incf context-size)

                 (let ((new-context
                        (mpc-songpointer-context context-size plbuf)))
                   (if (null new-context)
                       ;; There isn't more context: choose one arbitrarily
                       ;; and keep looking for a better match elsewhere.
                 (let ((new-context
                        (mpc-songpointer-context context-size plbuf)))
                   (if (null new-context)
                       ;; There isn't more context: choose one arbitrarily
                       ;; and keep looking for a better match elsewhere.

-                      (decf context-size)
+                      (cl-decf context-size)

                     (setq context new-context)
                     (setq score (mpc-songpointer-score context pos))
                     (save-excursion
                     (setq context new-context)
                     (setq score (mpc-songpointer-score context pos))
                     (save-excursion

diff --git a/lisp/msb.el b/lisp/msb.el
index 760ff61..d9fb2c5 100644 (file)
--- a/lisp/msb.el
+++ b/lisp/msb.el
@@ -77,13 +77,13 @@
 ;; hacked on by Dave Love.
 ;;; Code:
 
 ;; hacked on by Dave Love.
 ;;; Code:
 

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))

 
 

-;;;
-;;; Some example constants to be used for `msb-menu-cond'.  See that
-;;; variable for more information.  Please note that if the condition
-;;; returns `multi', then the buffer can appear in several menus.
-;;;
+;;
+;; Some example constants to be used for `msb-menu-cond'.  See that
+;; variable for more information.  Please note that if the condition
+;; returns `multi', then the buffer can appear in several menus.
+;;

 (defconst msb--few-menus
   '(((and (boundp 'server-buffer-clients)
          server-buffer-clients
 (defconst msb--few-menus
   '(((and (boundp 'server-buffer-clients)
          server-buffer-clients


@@ -702,18 +702,18 @@ See `msb-menu-cond' for a description of its elements."
        (multi-flag nil)
        function-info-list)
     (setq function-info-list
        (multi-flag nil)
        function-info-list)
     (setq function-info-list

-         (loop for fi
-               across function-info-vector
-               if (and (setq result
-                             (eval (aref fi 1))) ;Test CONDITION
-                       (not (and (eq result 'no-multi)
-                                 multi-flag))
-                       (progn (when (eq result 'multi)
-                                (setq multi-flag t))
-                              t))
-               collect fi
-               until (and result
-                          (not (eq result 'multi)))))
+         (cl-loop for fi
+                   across function-info-vector
+                   if (and (setq result
+                                 (eval (aref fi 1))) ;Test CONDITION
+                           (not (and (eq result 'no-multi)
+                                     multi-flag))
+                           (progn (when (eq result 'multi)
+                                    (setq multi-flag t))
+                                  t))
+                   collect fi
+                   until (and result
+                              (not (eq result 'multi)))))

     (when (and (not function-info-list)
               (not result))
       (error "No catch-all in msb-menu-cond!"))
     (when (and (not function-info-list)
               (not result))
       (error "No catch-all in msb-menu-cond!"))


@@ -817,7 +817,7 @@ results in
 (defun msb--mode-menu-cond ()
   (let ((key msb-modes-key))
     (mapcar (lambda (item)
 (defun msb--mode-menu-cond ()
   (let ((key msb-modes-key))
     (mapcar (lambda (item)

-             (incf key)
+             (cl-incf key)

              (list `( eq major-mode (quote ,(car item)))
                    key
                    (concat (cdr item) " (%d)")))
              (list `( eq major-mode (quote ,(car item)))
                    key
                    (concat (cdr item) " (%d)")))


@@ -841,18 +841,18 @@ It takes the form ((TITLE . BUFFER-LIST)...)."
             (> msb-display-most-recently-used 0))
     (let* ((buffers (cdr (buffer-list)))
           (most-recently-used
             (> msb-display-most-recently-used 0))
     (let* ((buffers (cdr (buffer-list)))
           (most-recently-used

-           (loop with n = 0
-                 for buffer in buffers
-                 if (with-current-buffer buffer
-                      (and (not (msb-invisible-buffer-p))
-                           (not (eq major-mode 'dired-mode))))
-                 collect (with-current-buffer buffer
-                           (cons (funcall msb-item-handling-function
-                                          buffer
-                                          max-buffer-name-length)
-                                 buffer))
-                 and do (incf n)
-                 until (>= n msb-display-most-recently-used))))
+           (cl-loop with n = 0
+                     for buffer in buffers
+                     if (with-current-buffer buffer
+                          (and (not (msb-invisible-buffer-p))
+                               (not (eq major-mode 'dired-mode))))
+                     collect (with-current-buffer buffer
+                               (cons (funcall msb-item-handling-function
+                                              buffer
+                                              max-buffer-name-length)
+                                     buffer))
+                     and do (cl-incf n)
+                     until (>= n msb-display-most-recently-used))))

       (cons (if (stringp msb-most-recently-used-title)
                (format msb-most-recently-used-title
                        (length most-recently-used))
       (cons (if (stringp msb-most-recently-used-title)
                (format msb-most-recently-used-title
                        (length most-recently-used))


@@ -899,29 +899,29 @@ It takes the form ((TITLE . BUFFER-LIST)...)."
     (when file-buffers
       (setq file-buffers
            (mapcar (lambda (buffer-list)
     (when file-buffers
       (setq file-buffers
            (mapcar (lambda (buffer-list)

-                     (list* msb-files-by-directory-sort-key
-                             (car buffer-list)
-                             (sort
-                              (mapcar (lambda (buffer)
-                                        (cons (with-current-buffer buffer
-                                                (funcall
-                                                 msb-item-handling-function
-                                                 buffer
-                                                 max-buffer-name-length))
-                                              buffer))
-                                      (cdr buffer-list))
-                              (lambda (item1 item2)
-                                (string< (car item1) (car item2))))))
+                     `(,msb-files-by-directory-sort-key
+                        ,(car buffer-list)
+                        ,@(sort
+                           (mapcar (lambda (buffer)
+                                     (cons (with-current-buffer buffer
+                                             (funcall
+                                              msb-item-handling-function
+                                              buffer
+                                              max-buffer-name-length))
+                                           buffer))
+                                   (cdr buffer-list))
+                           (lambda (item1 item2)
+                             (string< (car item1) (car item2))))))

                     (msb--choose-file-menu file-buffers))))
     ;; Now make the menu - a list of (TITLE . BUFFER-LIST)
     (let* (menu
           (most-recently-used
            (msb--most-recently-used-menu max-buffer-name-length))
           (others (nconc file-buffers
                     (msb--choose-file-menu file-buffers))))
     ;; Now make the menu - a list of (TITLE . BUFFER-LIST)
     (let* (menu
           (most-recently-used
            (msb--most-recently-used-menu max-buffer-name-length))
           (others (nconc file-buffers

-                          (loop for elt
-                                across function-info-vector
-                                for value = (msb--create-sort-item elt)
-                                if value collect value))))
+                          (cl-loop for elt
+                                   across function-info-vector
+                                   for value = (msb--create-sort-item elt)
+                                   if value collect value))))

       (setq menu
            (mapcar 'cdr                ;Remove the SORT-KEY
                    ;; Sort the menus - not the items.
       (setq menu
            (mapcar 'cdr                ;Remove the SORT-KEY
                    ;; Sort the menus - not the items.


@@ -1039,7 +1039,7 @@ variable `msb-menu-cond'."
          (tmp-list nil))
       (while (< count msb-max-menu-items)
        (push (pop list) tmp-list)
          (tmp-list nil))
       (while (< count msb-max-menu-items)
        (push (pop list) tmp-list)

-       (incf count))
+       (cl-incf count))

       (setq tmp-list (nreverse tmp-list))
       (setq sub-name (concat (car (car tmp-list)) "..."))
       (push (nconc (list mcount sub-name
       (setq tmp-list (nreverse tmp-list))
       (setq sub-name (concat (car (car tmp-list)) "..."))
       (push (nconc (list mcount sub-name


@@ -1076,7 +1076,7 @@ variable `msb-menu-cond'."
                                  (cons (buffer-name (cdr item))
                                        (cons (car item) end)))
                                (cdr sub-menu))))
                                  (cons (buffer-name (cdr item))
                                        (cons (car item) end)))
                                (cdr sub-menu))))

-          (nconc (list (incf mcount) (car sub-menu)
+          (nconc (list (cl-incf mcount) (car sub-menu)

                        'keymap (car sub-menu))
                  (msb--split-menus buffers))))))
      raw-menu)))
                        'keymap (car sub-menu))
                  (msb--split-menus buffers))))))
      raw-menu)))

diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 7d6dcf3..d0200f4 100644 (file)
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -45,8 +45,7 @@
 (defvar dbus-registered-objects-table)
 
 ;; Pacify byte compiler.
 (defvar dbus-registered-objects-table)
 
 ;; Pacify byte compiler.

-(eval-when-compile
-  (require 'cl))
+(eval-when-compile (require 'cl-lib))

 
 (require 'xml)
 
 
 (require 'xml)
 


@@ -494,20 +493,20 @@ placed in the queue.
     (dolist (flag flags)
       (setq arg
            (+ arg
     (dolist (flag flags)
       (setq arg
            (+ arg

-              (case flag
+              (pcase flag

                 (:allow-replacement 1)
                 (:replace-existing 2)
                 (:do-not-queue 4)
                 (:allow-replacement 1)
                 (:replace-existing 2)
                 (:do-not-queue 4)

-                (t (signal 'wrong-type-argument (list flag)))))))
+                (_ (signal 'wrong-type-argument (list flag)))))))

     (setq reply (dbus-call-method
                 bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
                 "RequestName" service arg))
     (setq reply (dbus-call-method
                 bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
                 "RequestName" service arg))

-    (case reply
+    (pcase reply

       (1 :primary-owner)
       (2 :in-queue)
       (3 :exists)
       (4 :already-owner)
       (1 :primary-owner)
       (2 :in-queue)
       (3 :exists)
       (4 :already-owner)

-      (t (signal 'dbus-error (list "Could not register service" service))))))
+      (_ (signal 'dbus-error (list "Could not register service" service))))))

 
 (defun dbus-unregister-service (bus service)
   "Unregister all objects related to SERVICE from D-Bus BUS.
 
 (defun dbus-unregister-service (bus service)
   "Unregister all objects related to SERVICE from D-Bus BUS.


@@ -536,11 +535,11 @@ queue of this service."
   (let ((reply (dbus-call-method
                bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
                "ReleaseName" service)))
   (let ((reply (dbus-call-method
                bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
                "ReleaseName" service)))

-    (case reply
+    (pcase reply

       (1 :released)
       (2 :non-existent)
       (3 :not-owner)
       (1 :released)
       (2 :non-existent)
       (3 :not-owner)

-      (t (signal 'dbus-error (list "Could not unregister service" service))))))
+      (_ (signal 'dbus-error (list "Could not unregister service" service))))))

 
 (defun dbus-register-signal
   (bus service path interface signal handler &rest args)
 
 (defun dbus-register-signal
   (bus service path interface signal handler &rest args)


@@ -803,7 +802,7 @@ association to the service from D-Bus."
                                ;; Service.
                                (string-equal service (cadr e))
                                ;; Non-empty object path.
                                ;; Service.
                                (string-equal service (cadr e))
                                ;; Non-empty object path.

-                               (caddr e)
+                               (cl-caddr e)

                                (throw :found t)))))
                         dbus-registered-objects-table)
                        nil))))
                                (throw :found t)))))
                         dbus-registered-objects-table)
                        nil))))


@@ -1383,7 +1382,7 @@ name of the property, and its value.  If there are no properties,
                bus service path dbus-interface-properties
                "GetAll" :timeout 500 interface)
               result)
                bus service path dbus-interface-properties
                "GetAll" :timeout 500 interface)
               result)

-       (add-to-list 'result (cons (car dict) (caadr dict)) 'append)))))
+       (add-to-list 'result (cons (car dict) (cl-caadr dict)) 'append)))))

 
 (defun dbus-register-property
   (bus service path interface property access value
 
 (defun dbus-register-property
   (bus service path interface property access value


@@ -1581,7 +1580,7 @@ and \"org.freedesktop.DBus.Properties.GetAll\", which is slow."
                (if (cadr entry2)
                    ;; "sv".
                    (dolist (entry3 (cadr entry2))
                (if (cadr entry2)
                    ;; "sv".
                    (dolist (entry3 (cadr entry2))

-                     (setcdr entry3 (caadr entry3)))
+                     (setcdr entry3 (cl-caadr entry3)))

                  (setcdr entry2 nil)))))
 
        ;; Fallback: collect the information.  Slooow!
                  (setcdr entry2 nil)))))
 
        ;; Fallback: collect the information.  Slooow!

diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index a306384..d33480a 100644 (file)
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -35,7 +35,7 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))

 
 (defgroup gnutls nil
   "Emacs interface to the GnuTLS library."
 
 (defgroup gnutls nil
   "Emacs interface to the GnuTLS library."


@@ -120,7 +120,7 @@ trust and key files, and priority string."
 (declare-function gnutls-boot "gnutls.c" (proc type proplist))
 (declare-function gnutls-errorp "gnutls.c" (error))
 
 (declare-function gnutls-boot "gnutls.c" (proc type proplist))
 (declare-function gnutls-errorp "gnutls.c" (error))
 

-(defun* gnutls-negotiate
+(cl-defun gnutls-negotiate

     (&rest spec
            &key process type hostname priority-string
            trustfiles crlfiles keylist min-prime-bits
     (&rest spec
            &key process type hostname priority-string
            trustfiles crlfiles keylist min-prime-bits

diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index c9961a6..b71bfb2 100644 (file)
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -118,7 +118,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))

 (require 'comint)
 
 (defgroup pcomplete nil
 (require 'comint)
 
 (defgroup pcomplete nil


@@ -875,9 +874,9 @@ component, `default-directory' is used as the basis for completion."
                 ;; The env-var is "out of bounds".
                 (if (eq action t)
                     (complete-with-action action table newstring pred)
                 ;; The env-var is "out of bounds".
                 (if (eq action t)
                     (complete-with-action action table newstring pred)

-                  (list* 'boundaries
-                         (+ (car bounds) (- orig-length (length newstring)))
-                         (cdr bounds)))
+                  `(boundaries
+                    ,(+ (car bounds) (- orig-length (length newstring)))
+                    . ,(cdr bounds)))

               ;; The env-var is in the file bounds.
               (if (eq action t)
                   (let ((comps (complete-with-action
               ;; The env-var is in the file bounds.
               (if (eq action t)
                   (let ((comps (complete-with-action


@@ -886,9 +885,9 @@ component, `default-directory' is used as the basis for completion."
                     ;; Strip the part of each completion that's actually
                     ;; coming from the env-var.
                     (mapcar (lambda (s) (substring s len)) comps))
                     ;; Strip the part of each completion that's actually
                     ;; coming from the env-var.
                     (mapcar (lambda (s) (substring s len)) comps))

-                (list* 'boundaries
-                       (+ envpos (- orig-length (length newstring)))
-                       (cdr bounds))))))))))
+                `(boundaries
+                  ,(+ envpos (- orig-length (length newstring)))
+                  . ,(cdr bounds))))))))))

 
 (defsubst pcomplete-all-entries (&optional regexp predicate)
   "Like `pcomplete-entries', but doesn't ignore any entries."
 
 (defsubst pcomplete-all-entries (&optional regexp predicate)
   "Like `pcomplete-entries', but doesn't ignore any entries."

diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index a07ecfc..f42f661 100644 (file)
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -198,7 +198,7 @@
 
 (eval-when-compile
   (require 'skeleton)
 
 (eval-when-compile
   (require 'skeleton)

-  (require 'cl)
+  (require 'cl-lib)

   (require 'comint))
 (require 'executable)
 
   (require 'comint))
 (require 'executable)
 


@@ -987,31 +987,31 @@ subshells can nest."
       (while (and state (progn (skip-chars-forward "^'\\\\\"`$()" limit)
                                (< (point) limit)))
         ;; unescape " inside a $( ... ) construct.
       (while (and state (progn (skip-chars-forward "^'\\\\\"`$()" limit)
                                (< (point) limit)))
         ;; unescape " inside a $( ... ) construct.

-        (case (char-after)
-          (?\' (case state
-                 (double-quote nil)
-                 (t (forward-char 1) (skip-chars-forward "^'" limit))))
+        (pcase (char-after)
+          (?\' (pcase state
+                 (`double-quote nil)
+                 (_ (forward-char 1) (skip-chars-forward "^'" limit))))

           (?\\ (forward-char 1))
           (?\\ (forward-char 1))

-          (?\" (case state
-                 (double-quote (setq state (pop states)))
-                 (t (push state states) (setq state 'double-quote)))
+          (?\" (pcase state
+                 (`double-quote (setq state (pop states)))
+                 (_ (push state states) (setq state 'double-quote)))

                (if state (put-text-property (point) (1+ (point))
                                             'syntax-table '(1))))
                (if state (put-text-property (point) (1+ (point))
                                             'syntax-table '(1))))

-          (?\` (case state
-                 (backquote (setq state (pop states)))
-                 (t (push state states) (setq state 'backquote))))
+          (?\` (pcase state
+                 (`backquote (setq state (pop states)))
+                 (_ (push state states) (setq state 'backquote))))

           (?\$ (if (not (eq (char-after (1+ (point))) ?\())
                    nil
                  (forward-char 1)
           (?\$ (if (not (eq (char-after (1+ (point))) ?\())
                    nil
                  (forward-char 1)

-                 (case state
-                   (t (push state states) (setq state 'code)))))
-          (?\( (case state
-                 (double-quote nil)
-                 (t (push state states) (setq state 'code))))
-          (?\) (case state
-                 (double-quote nil)
-                 (t (setq state (pop states)))))
-          (t (error "Internal error in sh-font-lock-quoted-subshell")))
+                 (pcase state
+                   (_ (push state states) (setq state 'code)))))
+          (?\( (pcase state
+                 (`double-quote nil)
+                 (_ (push state states) (setq state 'code))))
+          (?\) (pcase state
+                 (`double-quote nil)
+                 (_ (setq state (pop states)))))
+          (_ (error "Internal error in sh-font-lock-quoted-subshell")))

         (forward-char 1)))))
 
 
         (forward-char 1)))))
 
 


@@ -1105,7 +1105,6 @@ subshells can nest."
            (save-excursion
              (sh-font-lock-quoted-subshell end)))))))
    (point) end))
            (save-excursion
              (sh-font-lock-quoted-subshell end)))))))
    (point) end))

-

 (defun sh-font-lock-syntactic-face-function (state)
   (let ((q (nth 3 state)))
     (if q
 (defun sh-font-lock-syntactic-face-function (state)
   (let ((q (nth 3 state)))
     (if q


@@ -1649,7 +1648,7 @@ Does not preserve point."
       (cond
        ((zerop (length prev))
         (if newline
       (cond
        ((zerop (length prev))
         (if newline

-            (progn (assert words) (setq res 'word))
+            (progn (cl-assert words) (setq res 'word))

           (setq words t)
           (condition-case nil
               (forward-sexp -1)
           (setq words t)
           (condition-case nil
               (forward-sexp -1)


@@ -1661,7 +1660,7 @@ Does not preserve point."
        ((assoc prev smie-grammar) (setq res 'word))
        (t
         (if newline
        ((assoc prev smie-grammar) (setq res 'word))
        (t
         (if newline

-            (progn (assert words) (setq res 'word))
+            (progn (cl-assert words) (setq res 'word))

           (setq words t)))))
     (eq res 'keyword)))
 
           (setq words t)))))
     (eq res 'keyword)))
 

diff --git a/lisp/register.el b/lisp/register.el
index 44f15e4..21fcff2 100644 (file)
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -28,7 +28,7 @@
 ;; pieces of buffer state to named variables.  The entry points are
 ;; documented in the Emacs user's manual.
 
 ;; pieces of buffer state to named variables.  The entry points are
 ;; documented in the Emacs user's manual.
 

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))

 
 (declare-function semantic-insert-foreign-tag "semantic/tag" (foreign-tag))
 (declare-function semantic-tag-buffer "semantic/tag" (tag))
 
 (declare-function semantic-insert-foreign-tag "semantic/tag" (foreign-tag))
 (declare-function semantic-tag-buffer "semantic/tag" (tag))


@@ -52,7 +52,7 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(defstruct
+(cl-defstruct

   (registerv (:constructor nil)
             (:constructor registerv--make (&optional data print-func
                                                      jump-func insert-func))
   (registerv (:constructor nil)
             (:constructor registerv--make (&optional data print-func
                                                      jump-func insert-func))


@@ -64,7 +64,7 @@
   (jump-func   nil :read-only t)
   (insert-func nil :read-only t))
 
   (jump-func   nil :read-only t)
   (insert-func nil :read-only t))
 

-(defun* registerv-make (data &key print-func jump-func insert-func)
+(cl-defun registerv-make (data &key print-func jump-func insert-func)

   "Create a register value object.
 
 DATA can be any value.
   "Create a register value object.
 
 DATA can be any value.


@@ -150,7 +150,7 @@ delete any existing frames that the frame configuration doesn't mention.
   (let ((val (get-register register)))
     (cond
      ((registerv-p val)
   (let ((val (get-register register)))
     (cond
      ((registerv-p val)

-      (assert (registerv-jump-func val) nil
+      (cl-assert (registerv-jump-func val) nil

               "Don't know how to jump to register %s"
               (single-key-description register))
       (funcall (registerv-jump-func val) (registerv-data val)))
               "Don't know how to jump to register %s"
               (single-key-description register))
       (funcall (registerv-jump-func val) (registerv-data val)))


@@ -325,7 +325,7 @@ Interactively, second arg is non-nil if prefix arg is supplied."
   (let ((val (get-register register)))
     (cond
      ((registerv-p val)
   (let ((val (get-register register)))
     (cond
      ((registerv-p val)

-      (assert (registerv-insert-func val) nil
+      (cl-assert (registerv-insert-func val) nil

               "Don't know how to insert register %s"
               (single-key-description register))
       (funcall (registerv-insert-func val) (registerv-data val)))
               "Don't know how to insert register %s"
               (single-key-description register))
       (funcall (registerv-insert-func val) (registerv-data val)))

diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el
index c6c7d7d..0d693c5 100644 (file)
--- a/lisp/scroll-bar.el
+++ b/lisp/scroll-bar.el
@@ -29,7 +29,7 @@
 ;;; Code:
 
 (require 'mouse)
 ;;; Code:
 
 (require 'mouse)

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))

 
 \f
 ;;;; Utilities.
 
 \f
 ;;;; Utilities.


@@ -112,8 +112,9 @@ Setting the variable with a customization buffer also takes effect."
 ;; If it is set again, that is for real.
 (setq scroll-bar-mode-explicit t)
 
 ;; If it is set again, that is for real.
 (setq scroll-bar-mode-explicit t)
 

-(defun get-scroll-bar-mode () scroll-bar-mode)
-(defsetf get-scroll-bar-mode set-scroll-bar-mode)
+(defun get-scroll-bar-mode ()
+  (declare (gv-setter set-scroll-bar-mode))
+  scroll-bar-mode)

 
 (define-minor-mode scroll-bar-mode
   "Toggle vertical scroll bars on all frames (Scroll Bar mode).
 
 (define-minor-mode scroll-bar-mode
   "Toggle vertical scroll bars on all frames (Scroll Bar mode).

diff --git a/lisp/simple.el b/lisp/simple.el
index e6b4a79..37e0b48 100644 (file)
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -28,8 +28,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))       ;For define-minor-mode.
-

 (declare-function widget-convert "wid-edit" (type &rest args))
 (declare-function shell-mode "shell" ())
 
 (declare-function widget-convert "wid-edit" (type &rest args))
 (declare-function shell-mode "shell" ())
 

diff --git a/lisp/uniquify.el b/lisp/uniquify.el
index 520c4b8..3619d49 100644 (file)
--- a/lisp/uniquify.el
+++ b/lisp/uniquify.el
@@ -83,7 +83,7 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))

 
 ;;; User-visible variables
 
 
 ;;; User-visible variables
 


@@ -174,7 +174,7 @@ contains the name of the directory which the buffer is visiting.")
 ;;; Utilities
 
 ;; uniquify-fix-list data structure
 ;;; Utilities
 
 ;; uniquify-fix-list data structure

-(defstruct (uniquify-item
+(cl-defstruct (uniquify-item

            (:constructor nil) (:copier nil)
            (:constructor uniquify-make-item
             (base dirname buffer &optional proposed)))
            (:constructor nil) (:copier nil)
            (:constructor uniquify-make-item
             (base dirname buffer &optional proposed)))


@@ -340,7 +340,7 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil."
 
 (defun uniquify-get-proposed-name (base dirname &optional depth)
   (unless depth (setq depth uniquify-min-dir-content))
 
 (defun uniquify-get-proposed-name (base dirname &optional depth)
   (unless depth (setq depth uniquify-min-dir-content))

-  (assert (equal (directory-file-name dirname) dirname))  ;No trailing slash.
+  (cl-assert (equal (directory-file-name dirname) dirname)) ;No trailing slash.

 
   ;; Distinguish directories by adding extra separator.
   (if (and uniquify-trailing-separator-p
 
   ;; Distinguish directories by adding extra separator.
   (if (and uniquify-trailing-separator-p

diff --git a/lisp/vc/cvs-status.el b/lisp/vc/cvs-status.el
index f803cc4..6c6b18a 100644 (file)
--- a/lisp/vc/cvs-status.el
+++ b/lisp/vc/cvs-status.el
@@ -28,7 +28,7 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))

 (require 'pcvs-util)
 
 ;;;
 (require 'pcvs-util)
 
 ;;;


@@ -165,7 +165,7 @@
 ;; Tagelt, tag element
 ;;
 
 ;; Tagelt, tag element
 ;;
 

-(defstruct (cvs-tag
+(cl-defstruct (cvs-tag

            (:constructor nil)
            (:constructor cvs-tag-make
                          (vlist &optional name type))
            (:constructor nil)
            (:constructor cvs-tag-make
                          (vlist &optional name type))


@@ -235,9 +235,9 @@ The tree will be printed no closer than column COLUMN."
              (save-excursion
                (or (= (forward-line 1) 0) (insert "\n"))
                (cvs-tree-print rest printer column))))
              (save-excursion
                (or (= (forward-line 1) 0) (insert "\n"))
                (cvs-tree-print rest printer column))))

-       (assert (>= prefix column))
+       (cl-assert (>= prefix column))

        (move-to-column prefix t)
        (move-to-column prefix t)

-       (assert (eolp))
+       (cl-assert (eolp))

        (insert (cvs-car name))
        (dolist (br (cvs-cdr rev))
          (let* ((column (current-column))
        (insert (cvs-car name))
        (dolist (br (cvs-cdr rev))
          (let* ((column (current-column))


@@ -258,7 +258,7 @@ The tree will be printed no closer than column COLUMN."
 (defun cvs-tree-merge (tree1 tree2)
   "Merge tags trees TREE1 and TREE2 into one.
 BEWARE:  because of stability issues, this is not a symmetric operation."
 (defun cvs-tree-merge (tree1 tree2)
   "Merge tags trees TREE1 and TREE2 into one.
 BEWARE:  because of stability issues, this is not a symmetric operation."

-  (assert (and (listp tree1) (listp tree2)))
+  (cl-assert (and (listp tree1) (listp tree2)))

   (cond
    ((null tree1) tree2)
    ((null tree2) tree1)
   (cond
    ((null tree1) tree2)
    ((null tree2) tree1)


@@ -273,10 +273,10 @@ BEWARE:  because of stability issues, this is not a symmetric operation."
           (l2 (length vl2)))
     (cond
      ((= l1 l2)
           (l2 (length vl2)))
     (cond
      ((= l1 l2)

-      (case (cvs-tag-compare tag1 tag2)
-       (more1 (list* rev2 (cvs-tree-merge tree1 (cdr tree2))))
-       (more2 (list* rev1 (cvs-tree-merge (cdr tree1) tree2)))
-       (equal
+      (pcase (cvs-tag-compare tag1 tag2)
+       (`more1 (cons rev2 (cvs-tree-merge tree1 (cdr tree2))))
+       (`more2 (cons rev1 (cvs-tree-merge (cdr tree1) tree2)))
+       (`equal

         (cons (cons (cvs-tag-merge tag1 tag2)
                     (cvs-tree-merge (cvs-cdr rev1) (cvs-cdr rev2)))
               (cvs-tree-merge (cdr tree1) (cdr tree2))))))
         (cons (cons (cvs-tag-merge tag1 tag2)
                     (cvs-tree-merge (cvs-cdr rev1) (cvs-cdr rev2)))
               (cvs-tree-merge (cdr tree1) (cdr tree2))))))


@@ -399,35 +399,35 @@ the list is a three-string list TAG, KIND, REV."
 Otherwise, default to ASCII chars like +, - and |.")
 
 (defconst cvs-tree-char-space
 Otherwise, default to ASCII chars like +, - and |.")
 
 (defconst cvs-tree-char-space

-  (case cvs-tree-use-charset
-    (jisx0208 (make-char 'japanese-jisx0208 33 33))
-    (unicode " ")
-    (t "  ")))
+  (pcase cvs-tree-use-charset
+    (`jisx0208 (make-char 'japanese-jisx0208 33 33))
+    (`unicode " ")
+    (_ "  ")))

 (defconst cvs-tree-char-hbar
 (defconst cvs-tree-char-hbar

-  (case cvs-tree-use-charset
-    (jisx0208 (make-char 'japanese-jisx0208 40 44))
-    (unicode "━")
-    (t "--")))
+  (pcase cvs-tree-use-charset
+    (`jisx0208 (make-char 'japanese-jisx0208 40 44))
+    (`unicode "━")
+    (_ "--")))

 (defconst cvs-tree-char-vbar
 (defconst cvs-tree-char-vbar

-  (case cvs-tree-use-charset
-    (jisx0208 (make-char 'japanese-jisx0208 40 45))
-    (unicode "┃")
-    (t "| ")))
+  (pcase cvs-tree-use-charset
+    (`jisx0208 (make-char 'japanese-jisx0208 40 45))
+    (`unicode "┃")
+    (_ "| ")))

 (defconst cvs-tree-char-branch
 (defconst cvs-tree-char-branch

-  (case cvs-tree-use-charset
-    (jisx0208 (make-char 'japanese-jisx0208 40 50))
-    (unicode "┣")
-    (t "+-")))
+  (pcase cvs-tree-use-charset
+    (`jisx0208 (make-char 'japanese-jisx0208 40 50))
+    (`unicode "┣")
+    (_ "+-")))

 (defconst cvs-tree-char-eob            ;end of branch
 (defconst cvs-tree-char-eob            ;end of branch

-  (case cvs-tree-use-charset
-    (jisx0208 (make-char 'japanese-jisx0208 40 49))
-    (unicode "┗")
-    (t "`-")))
+  (pcase cvs-tree-use-charset
+    (`jisx0208 (make-char 'japanese-jisx0208 40 49))
+    (`unicode "┗")
+    (_ "`-")))

 (defconst cvs-tree-char-bob            ;beginning of branch
 (defconst cvs-tree-char-bob            ;beginning of branch

-  (case cvs-tree-use-charset
-    (jisx0208 (make-char 'japanese-jisx0208 40 51))
-    (unicode "┳")
-    (t "+-")))
+  (pcase cvs-tree-use-charset
+    (`jisx0208 (make-char 'japanese-jisx0208 40 51))
+    (`unicode "┳")
+    (_ "+-")))

 
 (defun cvs-tag-lessp (tag1 tag2)
   (eq (cvs-tag-compare tag1 tag2) 'more2))
 
 (defun cvs-tag-lessp (tag1 tag2)
   (eq (cvs-tag-compare tag1 tag2) 'more2))


@@ -485,9 +485,9 @@ Optional prefix ARG chooses between two representations."
           (pe t)                       ;"prev equal"
           (nas nil))                   ;"next afters" to be returned
       (insert "   ")
           (pe t)                       ;"prev equal"
           (nas nil))                   ;"next afters" to be returned
       (insert "   ")

-      (do* ((vs vlist (cdr vs))
-           (ps prev (cdr ps))
-           (as after (cdr as)))
+      (cl-do* ((vs vlist (cdr vs))
+               (ps prev (cdr ps))
+               (as after (cdr as)))

          ((and (null as) (null vs) (null ps))
           (let ((revname (cvs-status-vl-to-str vlist)))
             (if (cvs-every 'identity (cvs-map 'equal prev vlist))
          ((and (null as) (null vs) (null ps))
           (let ((revname (cvs-status-vl-to-str vlist)))
             (if (cvs-every 'identity (cvs-map 'equal prev vlist))

diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 9034ffe..a9d1247 100644 (file)
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -53,7 +53,7 @@
 ;; - Handle `diff -b' output in context->unified.
 
 ;;; Code:
 ;; - Handle `diff -b' output in context->unified.
 
 ;;; Code:

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))

 
 (defvar add-log-buffer-file-name-function)
 
 
 (defvar add-log-buffer-file-name-function)
 


@@ -493,14 +493,15 @@ See http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01990.html")
     ;; We may have a first evaluation of `end' thanks to the hunk header.
     (unless end
       (setq end (and (re-search-forward
     ;; We may have a first evaluation of `end' thanks to the hunk header.
     (unless end
       (setq end (and (re-search-forward

-                      (case style
-                        (unified (concat (if diff-valid-unified-empty-line
-                                             "^[^-+# \\\n]\\|" "^[^-+# \\]\\|")
-                                         ;; A `unified' header is ambiguous.
-                                         diff-file-header-re))
-                        (context "^[^-+#! \\]")
-                        (normal "^[^<>#\\]")
-                        (t "^[^-+#!<> \\]"))
+                      (pcase style
+                        (`unified
+                         (concat (if diff-valid-unified-empty-line
+                                     "^[^-+# \\\n]\\|" "^[^-+# \\]\\|")
+                                 ;; A `unified' header is ambiguous.
+                                 diff-file-header-re))
+                        (`context "^[^-+#! \\]")
+                        (`normal "^[^<>#\\]")
+                        (_ "^[^-+#!<> \\]"))

                       nil t)
                      (match-beginning 0)))
       (when diff-valid-unified-empty-line
                       nil t)
                      (match-beginning 0)))
       (when diff-valid-unified-empty-line


@@ -710,7 +711,7 @@ data such as \"Index: ...\" and such."
   (save-excursion
     (let ((n 0))
       (goto-char start)
   (save-excursion
     (let ((n 0))
       (goto-char start)

-      (while (re-search-forward re end t) (incf n))
+      (while (re-search-forward re end t) (cl-incf n))

       n)))
 
 (defun diff-splittable-p ()
       n)))
 
 (defun diff-splittable-p ()


@@ -834,16 +835,16 @@ PREFIX is only used internally: don't use it."
        ;; use any previously used preference
        (cdr (assoc fs diff-remembered-files-alist))
        ;; try to be clever and use previous choices as an inspiration
        ;; use any previously used preference
        (cdr (assoc fs diff-remembered-files-alist))
        ;; try to be clever and use previous choices as an inspiration

-       (dolist (rf diff-remembered-files-alist)
+       (cl-dolist (rf diff-remembered-files-alist)

         (let ((newfile (diff-merge-strings (caar rf) (car fs) (cdr rf))))
         (let ((newfile (diff-merge-strings (caar rf) (car fs) (cdr rf))))

-          (if (and newfile (file-exists-p newfile)) (return newfile))))
+          (if (and newfile (file-exists-p newfile)) (cl-return newfile))))

        ;; look for each file in turn.  If none found, try again but
        ;; ignoring the first level of directory, ...
        ;; look for each file in turn.  If none found, try again but
        ;; ignoring the first level of directory, ...

-       (do* ((files fs (delq nil (mapcar 'diff-filename-drop-dir files)))
-            (file nil nil))
+       (cl-do* ((files fs (delq nil (mapcar 'diff-filename-drop-dir files)))
+                (file nil nil))

           ((or (null files)
           ((or (null files)

-               (setq file (do* ((files files (cdr files))
-                                (file (car files) (car files)))
+               (setq file (cl-do* ((files files (cdr files))
+                                    (file (car files) (car files)))

                               ;; Use file-regular-p to avoid
                               ;; /dev/null, directories, etc.
                               ((or (null file) (file-regular-p file))
                               ;; Use file-regular-p to avoid
                               ;; /dev/null, directories, etc.
                               ((or (null file) (file-regular-p file))


@@ -862,7 +863,7 @@ PREFIX is only used internally: don't use it."
            (diff-find-file-name old noprompt (match-string 1)))
        ;; if all else fails, ask the user
        (unless noprompt
            (diff-find-file-name old noprompt (match-string 1)))
        ;; if all else fails, ask the user
        (unless noprompt

-         (let ((file (expand-file-name (or (first fs) ""))))
+         (let ((file (expand-file-name (or (car fs) ""))))

           (setq file
                 (read-file-name (format "Use file %s: " file)
                                 (file-name-directory file) file t
           (setq file
                 (read-file-name (format "Use file %s: " file)
                                 (file-name-directory file) file t


@@ -940,21 +941,23 @@ else cover the whole buffer."
                    (let ((modif nil) last-pt)
                      (while (progn (setq last-pt (point))
                                    (= (forward-line -1) 0))
                    (let ((modif nil) last-pt)
                      (while (progn (setq last-pt (point))
                                    (= (forward-line -1) 0))

-                       (case (char-after)
+                       (pcase (char-after)

                          (?\s (insert " ") (setq modif nil) (backward-char 1))
                          (?+ (delete-region (point) last-pt) (setq modif t))
                          (?- (if (not modif)
                          (?\s (insert " ") (setq modif nil) (backward-char 1))
                          (?+ (delete-region (point) last-pt) (setq modif t))
                          (?- (if (not modif)

-                                 (progn (forward-char 1)
-                                        (insert " "))
-                               (delete-char 1)
-                               (insert "! "))
-                             (backward-char 2))
+                                  (progn (forward-char 1)
+                                         (insert " "))
+                                (delete-char 1)
+                                (insert "! "))
+                              (backward-char 2))

                          (?\\ (when (save-excursion (forward-line -1)
                          (?\\ (when (save-excursion (forward-line -1)

-                                                    (= (char-after) ?+))
-                                (delete-region (point) last-pt) (setq modif t)))
+                                                     (= (char-after) ?+))
+                                 (delete-region (point) last-pt)
+                                 (setq modif t)))

                           ;; diff-valid-unified-empty-line.
                           ;; diff-valid-unified-empty-line.

-                          (?\n (insert "  ") (setq modif nil) (backward-char 2))
-                         (t (setq modif nil))))))
+                          (?\n (insert "  ") (setq modif nil)
+                               (backward-char 2))
+                         (_ (setq modif nil))))))

                  (goto-char (point-max))
                  (save-excursion
                    (insert "--- " line2 ","
                  (goto-char (point-max))
                  (save-excursion
                    (insert "--- " line2 ","


@@ -967,7 +970,8 @@ else cover the whole buffer."
                  (if (not (save-excursion (re-search-forward "^+" nil t)))
                      (delete-region (point) (point-max))
                    (let ((modif nil) (delete nil))
                  (if (not (save-excursion (re-search-forward "^+" nil t)))
                      (delete-region (point) (point-max))
                    (let ((modif nil) (delete nil))

-                     (if (save-excursion (re-search-forward "^\\+.*\n-" nil t))
+                     (if (save-excursion (re-search-forward "^\\+.*\n-"
+                                                             nil t))

                           ;; Normally, lines in a substitution come with
                           ;; first the removals and then the additions, and
                           ;; the context->unified function follows this
                           ;; Normally, lines in a substitution come with
                           ;; first the removals and then the additions, and
                           ;; the context->unified function follows this


@@ -976,22 +980,22 @@ else cover the whole buffer."
                           ;; context->unified as an undo command.
                          (setq reversible nil))
                      (while (not (eobp))
                           ;; context->unified as an undo command.
                          (setq reversible nil))
                      (while (not (eobp))

-                       (case (char-after)
+                       (pcase (char-after)

                          (?\s (insert " ") (setq modif nil) (backward-char 1))
                          (?- (setq delete t) (setq modif t))
                          (?+ (if (not modif)
                          (?\s (insert " ") (setq modif nil) (backward-char 1))
                          (?- (setq delete t) (setq modif t))
                          (?+ (if (not modif)

-                                 (progn (forward-char 1)
-                                        (insert " "))
-                               (delete-char 1)
-                               (insert "! "))
-                             (backward-char 2))
+                                  (progn (forward-char 1)
+                                         (insert " "))
+                                (delete-char 1)
+                                (insert "! "))
+                              (backward-char 2))

                          (?\\ (when (save-excursion (forward-line 1)
                          (?\\ (when (save-excursion (forward-line 1)

-                                                    (not (eobp)))
-                                (setq delete t) (setq modif t)))
+                                                     (not (eobp)))
+                                 (setq delete t) (setq modif t)))

                           ;; diff-valid-unified-empty-line.
                           (?\n (insert "  ") (setq modif nil) (backward-char 2)
                                (setq reversible nil))
                           ;; diff-valid-unified-empty-line.
                           (?\n (insert "  ") (setq modif nil) (backward-char 2)
                                (setq reversible nil))

-                         (t (setq modif nil)))
+                         (_ (setq modif nil)))

                        (let ((last-pt (point)))
                          (forward-line 1)
                          (when delete
                        (let ((last-pt (point)))
                          (forward-line 1)
                          (when delete


@@ -1051,17 +1055,18 @@ With a prefix argument, convert unified format to context format."
                   (goto-char pt1)
                   (forward-line 1)
                   (while (< (point) pt2)
                   (goto-char pt1)
                   (forward-line 1)
                   (while (< (point) pt2)

-                    (case (char-after)
+                    (pcase (char-after)

                       (?! (delete-char 2) (insert "-") (forward-line 1))
                       (?- (forward-char 1) (delete-char 1) (forward-line 1))
                       (?! (delete-char 2) (insert "-") (forward-line 1))
                       (?- (forward-char 1) (delete-char 1) (forward-line 1))

-                      (?\s           ;merge with the other half of the chunk
+                      (?\s              ;merge with the other half of the chunk

                        (let* ((endline2
                                (save-excursion
                                  (goto-char pt2) (forward-line 1) (point))))
                        (let* ((endline2
                                (save-excursion
                                  (goto-char pt2) (forward-line 1) (point))))

-                         (case (char-after pt2)
-                           ((?! ?+)
+                         (pcase (char-after pt2)
+                           ((or ?! ?+)

                             (insert "+"
                             (insert "+"

-                                    (prog1 (buffer-substring (+ pt2 2) endline2)
+                                    (prog1
+                                        (buffer-substring (+ pt2 2) endline2)

                                       (delete-region pt2 endline2))))
                            (?\s
                             (unless (= (- endline2 pt2)
                                       (delete-region pt2 endline2))))
                            (?\s
                             (unless (= (- endline2 pt2)


@@ -1075,9 +1080,9 @@ With a prefix argument, convert unified format to context format."
                             (delete-char 1)
                             (forward-line 1))
                            (?\\ (forward-line 1))
                             (delete-char 1)
                             (forward-line 1))
                            (?\\ (forward-line 1))

-                           (t (setq reversible nil)
+                           (_ (setq reversible nil)

                               (delete-char 1) (forward-line 1)))))
                               (delete-char 1) (forward-line 1)))))

-                      (t (setq reversible nil) (forward-line 1))))
+                      (_ (setq reversible nil) (forward-line 1))))

                   (while (looking-at "[+! ] ")
                     (if (/= (char-after) ?!) (forward-char 1)
                       (delete-char 1) (insert "+"))
                   (while (looking-at "[+! ] ")
                     (if (/= (char-after) ?!) (forward-char 1)
                       (delete-char 1) (insert "+"))


@@ -1155,13 +1160,13 @@ else cover the whole buffer."
            (replace-match "@@ -\\8 +\\7 @@" nil)
            (forward-line 1)
            (let ((c (char-after)) first last)
            (replace-match "@@ -\\8 +\\7 @@" nil)
            (forward-line 1)
            (let ((c (char-after)) first last)

-             (while (case (setq c (char-after))
+             (while (pcase (setq c (char-after))

                       (?- (setq first (or first (point)))
                       (?- (setq first (or first (point)))

-                          (delete-char 1) (insert "+") t)
+                           (delete-char 1) (insert "+") t)

                       (?+ (setq last (or last (point)))
                       (?+ (setq last (or last (point)))

-                          (delete-char 1) (insert "-") t)
-                      ((?\\ ?#) t)
-                      (t (when (and first last (< first last))
+                           (delete-char 1) (insert "-") t)
+                      ((or ?\\ ?#) t)
+                      (_ (when (and first last (< first last))

                            (insert (delete-and-extract-region first last)))
                          (setq first nil last nil)
                          (memq c (if diff-valid-unified-empty-line
                            (insert (delete-and-extract-region first last)))
                          (setq first nil last nil)
                          (memq c (if diff-valid-unified-empty-line


@@ -1184,13 +1189,13 @@ else cover the whole buffer."
                    (concat diff-hunk-header-re-unified
                            "\\|[-*][-*][-*] [0-9,]+ [-*][-*][-*][-*]$"
                            "\\|--- .+\n\\+\\+\\+ ")))
                    (concat diff-hunk-header-re-unified
                            "\\|[-*][-*][-*] [0-9,]+ [-*][-*][-*][-*]$"
                            "\\|--- .+\n\\+\\+\\+ ")))

-             (case (char-after)
-               (?\s (incf space))
-               (?+ (incf plus))
-               (?- (incf minus))
-               (?! (incf bang))
-               ((?\\ ?#) nil)
-               (t  (setq space 0 plus 0 minus 0 bang 0)))
+             (pcase (char-after)
+               (?\s (cl-incf space))
+               (?+ (cl-incf plus))
+               (?- (cl-incf minus))
+               (?! (cl-incf bang))
+               ((or ?\\ ?#) nil)
+               (_  (setq space 0 plus 0 minus 0 bang 0)))

            (cond
             ((looking-at diff-hunk-header-re-unified)
              (let* ((old1 (match-string 2))
            (cond
             ((looking-at diff-hunk-header-re-unified)
              (let* ((old1 (match-string 2))


@@ -1432,7 +1437,7 @@ Only works for unified diffs."
         (cond
          ((and (memq (char-after) '(?\s ?! ?+ ?-))
                (memq (char-after (1+ (point))) '(?\s ?\t)))
         (cond
          ((and (memq (char-after) '(?\s ?! ?+ ?-))
                (memq (char-after (1+ (point))) '(?\s ?\t)))

-          (decf count) t)
+          (cl-decf count) t)

          ((or (zerop count) (= count lines)) nil)
          ((memq (char-after) '(?! ?+ ?-))
           (if (not (and (eq (char-after (1+ (point))) ?\n)
          ((or (zerop count) (= count lines)) nil)
          ((memq (char-after) '(?! ?+ ?-))
           (if (not (and (eq (char-after (1+ (point))) ?\n)


@@ -1483,8 +1488,8 @@ Only works for unified diffs."
                 (after (string-to-number (or (match-string 4) "1"))))
             (forward-line)
             (while
                 (after (string-to-number (or (match-string 4) "1"))))
             (forward-line)
             (while

-                (case (char-after)
-                  (?\s (decf before) (decf after) t)
+                (pcase (char-after)
+                  (?\s (cl-decf before) (cl-decf after) t)

                   (?-
                    (if (and (looking-at diff-file-header-re)
                             (zerop before) (zerop after))
                   (?-
                    (if (and (looking-at diff-file-header-re)
                             (zerop before) (zerop after))


@@ -1494,15 +1499,15 @@ Only works for unified diffs."
                        ;; line so that our code which doesn't count lines
                        ;; will not get confused.
                        (progn (save-excursion (insert "\n")) nil)
                        ;; line so that our code which doesn't count lines
                        ;; will not get confused.
                        (progn (save-excursion (insert "\n")) nil)

-                     (decf before) t))
-                  (?+ (decf after) t)
-                  (t
+                     (cl-decf before) t))
+                  (?+ (cl-decf after) t)
+                  (_

                    (cond
                     ((and diff-valid-unified-empty-line
                           ;; Not just (eolp) so we don't infloop at eob.
                           (eq (char-after) ?\n)
                           (> before 0) (> after 0))
                    (cond
                     ((and diff-valid-unified-empty-line
                           ;; Not just (eolp) so we don't infloop at eob.
                           (eq (char-after) ?\n)
                           (> before 0) (> after 0))

-                     (decf before) (decf after) t)
+                     (cl-decf before) (cl-decf after) t)

                     ((and (zerop before) (zerop after)) nil)
                     ((or (< before 0) (< after 0))
                      (error (if (or (zerop before) (zerop after))
                     ((and (zerop before) (zerop after)) nil)
                     ((or (< before 0) (< after 0))
                      (error (if (or (zerop before) (zerop after))


@@ -1719,16 +1724,17 @@ the value of this variable when given an appropriate prefix argument).
 
 With a prefix argument, REVERSE the hunk."
   (interactive "P")
 
 With a prefix argument, REVERSE the hunk."
   (interactive "P")

-  (destructuring-bind (buf line-offset pos old new &optional switched)
-      ;; Sometimes we'd like to have the following behavior: if REVERSE go
-      ;; to the new file, otherwise go to the old.  But that means that by
-      ;; default we use the old file, which is the opposite of the default
-      ;; for diff-goto-source, and is thus confusing.  Also when you don't
-      ;; know about it it's pretty surprising.
-      ;; TODO: make it possible to ask explicitly for this behavior.
-      ;;
-      ;; This is duplicated in diff-test-hunk.
-      (diff-find-source-location nil reverse)
+  (pcase-let ((`(,buf ,line-offset ,pos ,old ,new ,switched)
+               ;; Sometimes we'd like to have the following behavior: if
+               ;; REVERSE go to the new file, otherwise go to the old.
+               ;; But that means that by default we use the old file, which is
+               ;; the opposite of the default for diff-goto-source, and is thus
+               ;; confusing.  Also when you don't know about it it's
+               ;; pretty surprising.
+               ;; TODO: make it possible to ask explicitly for this behavior.
+               ;;
+               ;; This is duplicated in diff-test-hunk.
+               (diff-find-source-location nil reverse)))

     (cond
      ((null line-offset)
       (error "Can't find the text to patch"))
     (cond
      ((null line-offset)
       (error "Can't find the text to patch"))


@@ -1771,8 +1777,8 @@ With a prefix argument, REVERSE the hunk."
   "See whether it's possible to apply the current hunk.
 With a prefix argument, try to REVERSE the hunk."
   (interactive "P")
   "See whether it's possible to apply the current hunk.
 With a prefix argument, try to REVERSE the hunk."
   (interactive "P")

-  (destructuring-bind (buf line-offset pos src _dst &optional switched)
-      (diff-find-source-location nil reverse)
+  (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched)
+               (diff-find-source-location nil reverse)))

     (set-window-point (display-buffer buf) (+ (car pos) (cdr src)))
     (diff-hunk-status-msg line-offset (diff-xor reverse switched) t)))
 
     (set-window-point (display-buffer buf) (+ (car pos) (cdr src)))
     (diff-hunk-status-msg line-offset (diff-xor reverse switched) t)))
 


@@ -1791,8 +1797,8 @@ then `diff-jump-to-old-file' is also set, for the next invocations."
   ;; This is a convenient detail when using smerge-diff.
   (if event (posn-set-point (event-end event)))
   (let ((rev (not (save-excursion (beginning-of-line) (looking-at "[-<]")))))
   ;; This is a convenient detail when using smerge-diff.
   (if event (posn-set-point (event-end event)))
   (let ((rev (not (save-excursion (beginning-of-line) (looking-at "[-<]")))))

-    (destructuring-bind (buf line-offset pos src _dst &optional switched)
-       (diff-find-source-location other-file rev)
+    (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched)
+                 (diff-find-source-location other-file rev)))

       (pop-to-buffer buf)
       (goto-char (+ (car pos) (cdr src)))
       (diff-hunk-status-msg line-offset (diff-xor rev switched) t))))
       (pop-to-buffer buf)
       (goto-char (+ (car pos) (cdr src)))
       (diff-hunk-status-msg line-offset (diff-xor rev switched) t))))


@@ -1809,10 +1815,11 @@ For use in `add-log-current-defun-function'."
     (when (looking-at diff-hunk-header-re)
       (forward-line 1)
       (re-search-forward "^[^ ]" nil t))
     (when (looking-at diff-hunk-header-re)
       (forward-line 1)
       (re-search-forward "^[^ ]" nil t))

-    (destructuring-bind (&optional buf _line-offset pos src dst switched)
-        ;; Use `noprompt' since this is used in which-func-mode and such.
-       (ignore-errors                ;Signals errors in place of prompting.
-          (diff-find-source-location nil nil 'noprompt))
+    (pcase-let ((`(,buf ,_line-offset ,pos ,src ,dst ,switched)
+                 (ignore-errors         ;Signals errors in place of prompting.
+                   ;; Use `noprompt' since this is used in which-func-mode
+                   ;; and such.
+                   (diff-find-source-location nil nil 'noprompt))))

       (when buf
         (beginning-of-line)
         (or (when (memq (char-after) '(?< ?-))
       (when buf
         (beginning-of-line)
         (or (when (memq (char-after) '(?< ?-))


@@ -1835,7 +1842,7 @@ For use in `add-log-current-defun-function'."
   "Re-diff the current hunk, ignoring whitespace differences."
   (interactive)
   (let* ((char-offset (- (point) (diff-beginning-of-hunk t)))
   "Re-diff the current hunk, ignoring whitespace differences."
   (interactive)
   (let* ((char-offset (- (point) (diff-beginning-of-hunk t)))

-        (opts (case (char-after) (?@ "-bu") (?* "-bc") (t "-b")))
+        (opts (pcase (char-after) (?@ "-bu") (?* "-bc") (_ "-b")))

         (line-nb (and (or (looking-at "[^0-9]+\\([0-9]+\\)")
                           (error "Can't find line number"))
                       (string-to-number (match-string 1))))
         (line-nb (and (or (looking-at "[^0-9]+\\([0-9]+\\)")
                           (error "Can't find line number"))
                       (string-to-number (match-string 1))))


@@ -1857,13 +1864,13 @@ For use in `add-log-current-defun-function'."
            (let ((status
                   (call-process diff-command nil t nil
                                 opts file1 file2)))
            (let ((status
                   (call-process diff-command nil t nil
                                 opts file1 file2)))

-             (case status
-               (0 nil)                 ;Nothing to reformat.
+             (pcase status
+               (0 nil)                 ;Nothing to reformat.

                (1 (goto-char (point-min))
                (1 (goto-char (point-min))

-                  ;; Remove the file-header.
-                  (when (re-search-forward diff-hunk-header-re nil t)
-                    (delete-region (point-min) (match-beginning 0))))
-               (t (goto-char (point-max))
+                   ;; Remove the file-header.
+                   (when (re-search-forward diff-hunk-header-re nil t)
+                     (delete-region (point-min) (match-beginning 0))))
+               (_ (goto-char (point-max))

                   (unless (bolp) (insert "\n"))
                   (insert hunk)))
              (setq hunk (buffer-string))
                   (unless (bolp) (insert "\n"))
                   (insert hunk)))
              (setq hunk (buffer-string))


@@ -1942,14 +1949,14 @@ For use in `add-log-current-defun-function'."
       (remove-overlays beg end 'diff-mode 'fine)
 
       (goto-char beg)
       (remove-overlays beg end 'diff-mode 'fine)
 
       (goto-char beg)

-      (case style
-        (unified
+      (pcase style
+        (`unified

          (while (re-search-forward "^\\(?:-.*\n\\)+\\(\\)\\(?:\\+.*\n\\)+"
                                    end t)
            (smerge-refine-subst (match-beginning 0) (match-end 1)
                                 (match-end 1) (match-end 0)
                                 nil 'diff-refine-preproc props-r props-a)))
          (while (re-search-forward "^\\(?:-.*\n\\)+\\(\\)\\(?:\\+.*\n\\)+"
                                    end t)
            (smerge-refine-subst (match-beginning 0) (match-end 1)
                                 (match-end 1) (match-end 0)
                                 nil 'diff-refine-preproc props-r props-a)))

-        (context
+        (`context

          (let* ((middle (save-excursion (re-search-forward "^---")))
                 (other middle))
            (while (re-search-forward "^\\(?:!.*\n\\)+" middle t)
          (let* ((middle (save-excursion (re-search-forward "^---")))
                 (other middle))
            (while (re-search-forward "^\\(?:!.*\n\\)+" middle t)


@@ -1964,7 +1971,7 @@ For use in `add-log-current-defun-function'."
                                   'diff-refine-preproc
                                   (unless diff-use-changed-face props-r)
                                   (unless diff-use-changed-face props-a)))))
                                   'diff-refine-preproc
                                   (unless diff-use-changed-face props-r)
                                   (unless diff-use-changed-face props-a)))))

-        (t ;; Normal diffs.
+        (_ ;; Normal diffs.

          (let ((beg1 (1+ (point))))
            (when (re-search-forward "^---.*\n" end t)
              ;; It's a combined add&remove, so there's something to do.
          (let ((beg1 (1+ (point))))
            (when (re-search-forward "^---.*\n" end t)
              ;; It's a combined add&remove, so there's something to do.

diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el
index 6cfee52..b70b6cd 100644 (file)
--- a/lisp/vc/diff.el
+++ b/lisp/vc/diff.el
@@ -32,8 +32,6 @@
 
 (declare-function diff-setup-whitespace "diff-mode" ())
 
 
 (declare-function diff-setup-whitespace "diff-mode" ())
 

-(eval-when-compile (require 'cl))
-

 (defgroup diff nil
   "Comparing files with `diff'."
   :group 'tools)
 (defgroup diff nil
   "Comparing files with `diff'."
   :group 'tools)

diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index 5ecd5c4..5ae3112 100644 (file)
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -29,7 +29,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))

 (require 'add-log)                     ; for all the ChangeLog goodies
 (require 'pcvs-util)
 (require 'ring)
 (require 'add-log)                     ; for all the ChangeLog goodies
 (require 'pcvs-util)
 (require 'ring)

diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el
index d345a20..07526b4 100644 (file)
--- a/lisp/vc/log-view.el
+++ b/lisp/vc/log-view.el
@@ -109,7 +109,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))

 (require 'pcvs-util)
 (autoload 'vc-find-revision "vc")
 (autoload 'vc-diff-internal "vc")
 (require 'pcvs-util)
 (autoload 'vc-find-revision "vc")
 (autoload 'vc-diff-internal "vc")

diff --git a/lisp/vc/pcvs-defs.el b/lisp/vc/pcvs-defs.el
index ab45b31..0f71b7b 100644 (file)
--- a/lisp/vc/pcvs-defs.el
+++ b/lisp/vc/pcvs-defs.el
@@ -26,7 +26,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))

 (require 'pcvs-util)
 
 ;;;; -------------------------------------------------------
 (require 'pcvs-util)
 
 ;;;; -------------------------------------------------------

diff --git a/lisp/vc/pcvs-info.el b/lisp/vc/pcvs-info.el
index 4f8c114..3657264 100644 (file)
--- a/lisp/vc/pcvs-info.el
+++ b/lisp/vc/pcvs-info.el
@@ -31,7 +31,7 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))

 (require 'pcvs-util)
 ;;(require 'pcvs-defs)
 
 (require 'pcvs-util)
 ;;(require 'pcvs-defs)
 


@@ -146,7 +146,7 @@ to confuse some users sometimes."
 
 ;; Constructor:
 
 
 ;; Constructor:
 

-(defstruct (cvs-fileinfo
+(cl-defstruct (cvs-fileinfo

            (:constructor nil)
            (:copier nil)
            (:constructor -cvs-create-fileinfo (type dir file full-log
            (:constructor nil)
            (:copier nil)
            (:constructor -cvs-create-fileinfo (type dir file full-log


@@ -274,10 +274,10 @@ to confuse some users sometimes."
                  (string= file (file-name-nondirectory file)))
             (setq check 'type)         (symbolp type)
             (setq check 'consistency)
                  (string= file (file-name-nondirectory file)))
             (setq check 'type)         (symbolp type)
             (setq check 'consistency)

-            (case type
-              (DIRCHANGE (and (null subtype) (string= "." file)))
-              ((NEED-UPDATE ADDED MISSING DEAD MODIFIED MESSAGE UP-TO-DATE
-                            REMOVED NEED-MERGE CONFLICT UNKNOWN MESSAGE)
+            (pcase type
+              (`DIRCHANGE (and (null subtype) (string= "." file)))
+              ((or `NEED-UPDATE `ADDED `MISSING `DEAD `MODIFIED `MESSAGE
+                    `UP-TO-DATE `REMOVED `NEED-MERGE `CONFLICT `UNKNOWN)

                t)))
        fi
       (error "Invalid :%s in cvs-fileinfo %s" check fi))))
                t)))
        fi
       (error "Invalid :%s in cvs-fileinfo %s" check fi))))


@@ -325,9 +325,9 @@ FI-OR-TYPE can either be a symbol (a fileinfo-type) or a fileinfo."
 (defun cvs-add-face (str face &optional keymap &rest props)
   (when keymap
     (when (keymapp keymap)
 (defun cvs-add-face (str face &optional keymap &rest props)
   (when keymap
     (when (keymapp keymap)

-      (setq props (list* 'keymap keymap props)))
-    (setq props (list* 'mouse-face 'highlight props)))
-  (add-text-properties 0 (length str) (list* 'font-lock-face face props) str)
+      (setq props `(keymap ,keymap ,@props)))
+    (setq props `(mouse-face highlight ,@props)))
+  (add-text-properties 0 (length str) `(font-lock-face ,face ,@props) str)

   str)
 
 (defun cvs-fileinfo-pp (fileinfo)
   str)
 
 (defun cvs-fileinfo-pp (fileinfo)


@@ -337,15 +337,15 @@ For use by the cookie package."
   (let ((type (cvs-fileinfo->type fileinfo))
        (subtype (cvs-fileinfo->subtype fileinfo)))
     (insert
   (let ((type (cvs-fileinfo->type fileinfo))
        (subtype (cvs-fileinfo->subtype fileinfo)))
     (insert

-     (case type
-       (DIRCHANGE (concat "In directory "
-                         (cvs-add-face (cvs-fileinfo->full-name fileinfo)
-                                       'cvs-header t 'cvs-goal-column t)
-                         ":"))
-       (MESSAGE
+     (pcase type
+       (`DIRCHANGE (concat "In directory "
+                           (cvs-add-face (cvs-fileinfo->full-name fileinfo)
+                                         'cvs-header t 'cvs-goal-column t)
+                           ":"))
+       (`MESSAGE

        (cvs-add-face (format "Message: %s" (cvs-fileinfo->full-log fileinfo))
                      'cvs-msg))
        (cvs-add-face (format "Message: %s" (cvs-fileinfo->full-log fileinfo))
                      'cvs-msg))

-       (t
+       (_

        (let* ((status (if (cvs-fileinfo->marked fileinfo)
                           (cvs-add-face "*" 'cvs-marked)
                         " "))
        (let* ((status (if (cvs-fileinfo->marked fileinfo)
                           (cvs-add-face "*" 'cvs-marked)
                         " "))


@@ -354,10 +354,10 @@ For use by the cookie package."
               (base (or (cvs-fileinfo->base-rev fileinfo) ""))
               (head (cvs-fileinfo->head-rev fileinfo))
               (type
               (base (or (cvs-fileinfo->base-rev fileinfo) ""))
               (head (cvs-fileinfo->head-rev fileinfo))
               (type

-               (let ((str (case type
+               (let ((str (pcase type

                             ;;(MOD-CONFLICT "Not Removed")
                             ;;(MOD-CONFLICT "Not Removed")

-                            (DEAD        "")
-                            (t (capitalize (symbol-name type)))))
+                            (`DEAD       "")
+                            (_ (capitalize (symbol-name type)))))

                      (face (let ((sym (intern
                                        (concat "cvs-fi-"
                                                (downcase (symbol-name type))
                      (face (let ((sym (intern
                                        (concat "cvs-fi-"
                                                (downcase (symbol-name type))

diff --git a/lisp/vc/pcvs-parse.el b/lisp/vc/pcvs-parse.el
index a588c73..dd448b9 100644 (file)
--- a/lisp/vc/pcvs-parse.el
+++ b/lisp/vc/pcvs-parse.el
@@ -32,8 +32,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
-

 (require 'pcvs-util)
 (require 'pcvs-info)
 
 (require 'pcvs-util)
 (require 'pcvs-info)
 


@@ -117,7 +115,7 @@ If RE matches, advance the point until the line after the match and
 then assign the variables as specified in MATCHES (via `setq')."
   (cons 'cvs-do-match
        (cons re (mapcar (lambda (match)
 then assign the variables as specified in MATCHES (via `setq')."
   (cons 'cvs-do-match
        (cons re (mapcar (lambda (match)

-                          `(cons ',(first match) ,(second match)))
+                          `(cons ',(car match) ,(cadr match)))

                         matches))))
 
 (defun cvs-do-match (re &rest matches)
                         matches))))
 
 (defun cvs-do-match (re &rest matches)


@@ -150,8 +148,8 @@ Match RE and if successful, execute MATCHES."
     (cvs-or
      (funcall parse-spec)
 
     (cvs-or
      (funcall parse-spec)
 

-     (dolist (re cvs-parse-ignored-messages)
-       (when (cvs-match re) (return t)))
+     (cl-dolist (re cvs-parse-ignored-messages)
+       (when (cvs-match re) (cl-return t)))

 
      ;; This is a parse error.  Create a message-type fileinfo.
      (and
 
      ;; This is a parse error.  Create a message-type fileinfo.
      (and


@@ -221,7 +219,7 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
       ;; ?: Unknown file.
       (let ((code (aref c 0)))
        (cvs-parsed-fileinfo
       ;; ?: Unknown file.
       (let ((code (aref c 0)))
        (cvs-parsed-fileinfo

-        (case code
+        (pcase code

           (?M 'MODIFIED)
           (?A 'ADDED)
           (?R 'REMOVED)
           (?M 'MODIFIED)
           (?A 'ADDED)
           (?R 'REMOVED)


@@ -238,7 +236,7 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
                (if (re-search-forward "^<<<<<<< " nil t)
                    'CONFLICT 'NEED-MERGE))))
           (?J 'NEED-MERGE)             ;not supported by standard CVS
                (if (re-search-forward "^<<<<<<< " nil t)
                    'CONFLICT 'NEED-MERGE))))
           (?J 'NEED-MERGE)             ;not supported by standard CVS

-          ((?U ?P)
+          ((or ?U ?P)

            (if dont-change-disc 'NEED-UPDATE
              (cons 'UP-TO-DATE (if (eq code ?U) 'UPDATED 'PATCHED)))))
         path 'trust)))
            (if dont-change-disc 'NEED-UPDATE
              (cons 'UP-TO-DATE (if (eq code ?U) 'UPDATED 'PATCHED)))))
         path 'trust)))

diff --git a/lisp/vc/pcvs-util.el b/lisp/vc/pcvs-util.el
index a3c525c..3d54bbd 100644 (file)
--- a/lisp/vc/pcvs-util.el
+++ b/lisp/vc/pcvs-util.el
@@ -26,7 +26,7 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))

 
 ;;;;
 ;;;; list processing
 
 ;;;;
 ;;;; list processing


@@ -63,7 +63,7 @@
        (while (and l (> n 1))
          (setcdr nl (list (pop l)))
          (setq nl (cdr nl))
        (while (and l (> n 1))
          (setcdr nl (list (pop l)))
          (setq nl (cdr nl))

-         (decf n))
+         (cl-decf n))

        ret))))
 
 (defun cvs-partition (p l)
        ret))))
 
 (defun cvs-partition (p l)


@@ -130,10 +130,10 @@ If NOREUSE is non-nil, always return a new buffer."
            (if noreuse (generate-new-buffer name)
              (get-buffer-create name)))
       (unless noreuse
            (if noreuse (generate-new-buffer name)
              (get-buffer-create name)))
       (unless noreuse

-       (dolist (buf (buffer-list))
+       (cl-dolist (buf (buffer-list))

          (with-current-buffer buf
            (when (equal name list-buffers-directory)
          (with-current-buffer buf
            (when (equal name list-buffers-directory)

-             (return buf)))))
+             (cl-return buf)))))

       (with-current-buffer (create-file-buffer name)
        (setq list-buffers-directory name)
        (current-buffer))))
       (with-current-buffer (create-file-buffer name)
        (setq list-buffers-directory name)
        (current-buffer))))


@@ -195,10 +195,10 @@ arguments.  If ARGS is not a list, no argument will be passed."
 ;;;; (interactive <foo>) support function
 ;;;;
 
 ;;;; (interactive <foo>) support function
 ;;;;
 

-(defstruct (cvs-qtypedesc
-           (:constructor nil) (:copier nil)
-           (:constructor cvs-qtypedesc-create
-                         (str2obj obj2str &optional complete hist-sym require)))
+(cl-defstruct (cvs-qtypedesc
+               (:constructor nil) (:copier nil)
+               (:constructor cvs-qtypedesc-create
+                (str2obj obj2str &optional complete hist-sym require)))

   str2obj
   obj2str
   hist-sym
   str2obj
   obj2str
   hist-sym


@@ -231,10 +231,10 @@ arguments.  If ARGS is not a list, no argument will be passed."
 ;;;; Flags handling
 ;;;;
 
 ;;;; Flags handling
 ;;;;
 

-(defstruct (cvs-flags
-           (:constructor nil)
-           (:constructor -cvs-flags-make
-                         (desc defaults &optional qtypedesc hist-sym)))
+(cl-defstruct (cvs-flags
+               (:constructor nil)
+               (:constructor -cvs-flags-make
+                (desc defaults &optional qtypedesc hist-sym)))

   defaults persist desc qtypedesc hist-sym)
 
 (defmacro cvs-flags-define (sym defaults
   defaults persist desc qtypedesc hist-sym)
 
 (defmacro cvs-flags-define (sym defaults

diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el
index 0508f45..659151a 100644 (file)
--- a/lisp/vc/pcvs.el
+++ b/lisp/vc/pcvs.el
@@ -118,7 +118,7 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))

 (require 'ewoc)                                ;Ewoc was once cookie
 (require 'pcvs-defs)
 (require 'pcvs-util)
 (require 'ewoc)                                ;Ewoc was once cookie
 (require 'pcvs-defs)
 (require 'pcvs-util)


@@ -219,21 +219,21 @@
 (autoload 'cvs-status-get-tags "cvs-status")
 (defun cvs-tags-list ()
   "Return a list of acceptable tags, ready for completions."
 (autoload 'cvs-status-get-tags "cvs-status")
 (defun cvs-tags-list ()
   "Return a list of acceptable tags, ready for completions."

-  (assert (cvs-buffer-p))
+  (cl-assert (cvs-buffer-p))

   (let ((marked (cvs-get-marked)))
   (let ((marked (cvs-get-marked)))

-    (list* '("BASE") '("HEAD")
-          (when marked
-            (with-temp-buffer
-              (process-file cvs-program
-                            nil        ;no input
-                            t          ;output to current-buffer
-                            nil        ;don't update display while running
-                            "status"
-                            "-v"
-                            (cvs-fileinfo->full-name (car marked)))
-              (goto-char (point-min))
-              (let ((tags (cvs-status-get-tags)))
-                (when (listp tags) tags)))))))
+    `(("BASE") ("HEAD")
+      ,@(when marked
+          (with-temp-buffer
+            (process-file cvs-program
+                          nil           ;no input
+                          t            ;output to current-buffer
+                          nil           ;don't update display while running
+                          "status"
+                          "-v"
+                          (cvs-fileinfo->full-name (car marked)))
+            (goto-char (point-min))
+            (let ((tags (cvs-status-get-tags)))
+              (when (listp tags) tags)))))))

 
 (defvar cvs-tag-history nil)
 (defconst cvs-qtypedesc-tag
 
 (defvar cvs-tag-history nil)
 (defconst cvs-qtypedesc-tag


@@ -426,16 +426,16 @@ If non-nil, NEW means to create a new buffer no matter what."
              ;; look for another cvs buffer visiting the same directory
              (save-excursion
                (unless new
              ;; look for another cvs buffer visiting the same directory
              (save-excursion
                (unless new

-                 (dolist (buffer (cons (current-buffer) (buffer-list)))
+                 (cl-dolist (buffer (cons (current-buffer) (buffer-list)))

                    (set-buffer buffer)
                    (and (cvs-buffer-p)
                    (set-buffer buffer)
                    (and (cvs-buffer-p)

-                        (case cvs-reuse-cvs-buffer
-                          (always t)
-                          (subdir
+                        (pcase cvs-reuse-cvs-buffer
+                          (`always t)
+                          (`subdir

                            (or (string-prefix-p default-directory dir)
                                (string-prefix-p dir default-directory)))
                            (or (string-prefix-p default-directory dir)
                                (string-prefix-p dir default-directory)))

-                          (samedir (string= default-directory dir)))
-                        (return buffer)))))
+                          (`samedir (string= default-directory dir)))
+                        (cl-return buffer)))))

              ;; we really have to create a new buffer:
              ;; we temporarily bind cwd to "" to prevent
              ;; create-file-buffer from using directory info
              ;; we really have to create a new buffer:
              ;; we temporarily bind cwd to "" to prevent
              ;; create-file-buffer from using directory info


@@ -478,7 +478,7 @@ If non-nil, NEW means to create a new buffer no matter what."
           ;;(set-buffer buf)
           buffer))))))
 
           ;;(set-buffer buf)
           buffer))))))
 

-(defun* cvs-cmd-do (cmd dir flags fis new
+(cl-defun cvs-cmd-do (cmd dir flags fis new

                        &key cvsargs noexist dont-change-disc noshow)
   (let* ((dir (file-name-as-directory
               (abbreviate-file-name (expand-file-name dir))))
                        &key cvsargs noexist dont-change-disc noshow)
   (let* ((dir (file-name-as-directory
               (abbreviate-file-name (expand-file-name dir))))


@@ -501,7 +501,7 @@ If non-nil, NEW means to create a new buffer no matter what."
 ;;            cvsbuf))))
 
 (defun cvs-run-process (args fis postprocess &optional single-dir)
 ;;            cvsbuf))))
 
 (defun cvs-run-process (args fis postprocess &optional single-dir)

-  (assert (cvs-buffer-p cvs-buffer))
+  (cl-assert (cvs-buffer-p cvs-buffer))

   (save-current-buffer
     (let ((procbuf (current-buffer))
          (cvsbuf cvs-buffer)
   (save-current-buffer
     (let ((procbuf (current-buffer))
          (cvsbuf cvs-buffer)


@@ -521,9 +521,9 @@ If non-nil, NEW means to create a new buffer no matter what."
                  (let ((inhibit-read-only t))
                    (insert "pcl-cvs: descending directory " dir "\n"))
                  ;; loop to find the same-dir-elems
                  (let ((inhibit-read-only t))
                    (insert "pcl-cvs: descending directory " dir "\n"))
                  ;; loop to find the same-dir-elems

-                 (do* ((files () (cons (cvs-fileinfo->file fi) files))
-                       (fis fis (cdr fis))
-                       (fi (car fis) (car fis)))
+                 (cl-do* ((files () (cons (cvs-fileinfo->file fi) files))
+                           (fis fis (cdr fis))
+                           (fi (car fis) (car fis)))

                      ((not (and fis (string= dir (cvs-fileinfo->dir fi))))
                       (list dir files fis))))))
             (dir (nth 0 dir+files+rest))
                      ((not (and fis (string= dir (cvs-fileinfo->dir fi))))
                       (list dir files fis))))))
             (dir (nth 0 dir+files+rest))


@@ -813,7 +813,7 @@ TIN specifies an optional starting point."
   (while (and tin (cvs-fileinfo< fi (ewoc-data tin)))
     (setq tin (ewoc-prev c tin)))
   (if (null tin) (ewoc-enter-first c fi) ;empty collection
   (while (and tin (cvs-fileinfo< fi (ewoc-data tin)))
     (setq tin (ewoc-prev c tin)))
   (if (null tin) (ewoc-enter-first c fi) ;empty collection

-    (assert (not (cvs-fileinfo< fi (ewoc-data tin))))
+    (cl-assert (not (cvs-fileinfo< fi (ewoc-data tin))))

     (let ((next-tin (ewoc-next c tin)))
       (while (not (or (null next-tin)
                      (cvs-fileinfo< fi (ewoc-data next-tin))))
     (let ((next-tin (ewoc-next c tin)))
       (while (not (or (null next-tin)
                      (cvs-fileinfo< fi (ewoc-data next-tin))))


@@ -871,15 +871,15 @@ RM-MSGS if non-nil means remove messages."
           (let* ((type (cvs-fileinfo->type fi))
                  (subtype (cvs-fileinfo->subtype fi))
                  (keep
           (let* ((type (cvs-fileinfo->type fi))
                  (subtype (cvs-fileinfo->subtype fi))
                  (keep

-                  (case type
+                  (pcase type

                     ;; remove temp messages and keep the others
                     ;; remove temp messages and keep the others

-                    (MESSAGE (not (or rm-msgs (eq subtype 'TEMP))))
+                    (`MESSAGE (not (or rm-msgs (eq subtype 'TEMP))))

                     ;; remove entries
                     ;; remove entries

-                    (DEAD nil)
+                    (`DEAD nil)

                     ;; handled also?
                     ;; handled also?

-                    (UP-TO-DATE (not rm-handled))
+                    (`UP-TO-DATE (not rm-handled))

                     ;; keep the rest
                     ;; keep the rest

-                    (t (not (run-hook-with-args-until-success
+                    (_ (not (run-hook-with-args-until-success

                              'cvs-cleanup-functions fi))))))
 
             ;; mark dirs for removal
                              'cvs-cleanup-functions fi))))))
 
             ;; mark dirs for removal


@@ -1389,7 +1389,7 @@ an empty list if it doesn't point to a file at all."
                      fis))))
     (nreverse fis)))
 
                      fis))))
     (nreverse fis)))
 

-(defun* cvs-mode-marked (filter &optional cmd
+(cl-defun cvs-mode-marked (filter &optional cmd

                                &key read-only one file noquery)
   "Get the list of marked FIS.
 CMD is used to determine whether to use the marks or not.
                                &key read-only one file noquery)
   "Get the list of marked FIS.
 CMD is used to determine whether to use the marks or not.


@@ -1474,7 +1474,7 @@ The POSTPROC specified there (typically `log-edit') is then called,
   (let ((msg (buffer-substring-no-properties (point-min) (point-max))))
     (cvs-mode!)
     ;;(pop-to-buffer cvs-buffer)
   (let ((msg (buffer-substring-no-properties (point-min) (point-max))))
     (cvs-mode!)
     ;;(pop-to-buffer cvs-buffer)

-    (cvs-mode-do "commit" (list* "-m" msg flags) 'commit)))
+    (cvs-mode-do "commit" `("-m" ,msg ,@flags) 'commit)))

 
 
 ;;;; Editing existing commit log messages.
 
 
 ;;;; Editing existing commit log messages.


@@ -1604,7 +1604,7 @@ With prefix argument, prompt for cvs flags."
                         (or current-prefix-arg (not cvs-add-default-message)))
                    (read-from-minibuffer "Enter description: ")
                  (or cvs-add-default-message "")))
                         (or current-prefix-arg (not cvs-add-default-message)))
                    (read-from-minibuffer "Enter description: ")
                  (or cvs-add-default-message "")))

-          (flags (list* "-m" msg flags))
+          (flags `("-m" ,msg ,@flags))

           (postproc
            ;; setup postprocessing for the directory entries
            (when dirs
           (postproc
            ;; setup postprocessing for the directory entries
            (when dirs


@@ -1845,7 +1845,7 @@ Signal an error if there is no backup file."
          (setq ret t)))
       ret)))
 
          (setq ret t)))
       ret)))
 

-(defun* cvs-mode-run (cmd flags fis
+(cl-defun cvs-mode-run (cmd flags fis

                      &key (buf (cvs-temp-buffer))
                           dont-change-disc cvsargs postproc)
   "Generic cvs-mode-<foo> function.
                      &key (buf (cvs-temp-buffer))
                           dont-change-disc cvsargs postproc)
   "Generic cvs-mode-<foo> function.


@@ -1887,7 +1887,7 @@ POSTPROC is a list of expressions to be evaluated at the very end (after
       (cvs-run-process args fis postproc single-dir))))
 
 
       (cvs-run-process args fis postproc single-dir))))
 
 

-(defun* cvs-mode-do (cmd flags filter
+(cl-defun cvs-mode-do (cmd flags filter

                     &key show dont-change-disc cvsargs postproc)
   "Generic cvs-mode-<foo> function.
 Executes `cvs CVSARGS CMD FLAGS' on the selected files.
                     &key show dont-change-disc cvsargs postproc)
   "Generic cvs-mode-<foo> function.
 Executes `cvs CVSARGS CMD FLAGS' on the selected files.

diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index cf1cdab..e6b6303 100644 (file)
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -43,7 +43,7 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))

 (require 'diff-mode)                    ;For diff-auto-refine-mode.
 (require 'newcomment)
 
 (require 'diff-mode)                    ;For diff-auto-refine-mode.
 (require 'newcomment)
 


@@ -716,7 +716,7 @@ major modes.  Uses `smerge-resolve-function' to do the actual work."
     (while (or (not (match-end i))
               (< (point) (match-beginning i))
               (>= (point) (match-end i)))
     (while (or (not (match-end i))
               (< (point) (match-beginning i))
               (>= (point) (match-end i)))

-      (decf i))
+      (cl-decf i))

     i))
 
 (defun smerge-keep-current ()
     i))
 
 (defun smerge-keep-current ()


@@ -779,7 +779,7 @@ An error is raised if not inside a conflict."
               (filename (or (match-string 1) ""))
 
               (_ (re-search-forward smerge-end-re))
               (filename (or (match-string 1) ""))
 
               (_ (re-search-forward smerge-end-re))

-              (_ (assert (< orig-point (match-end 0))))
+              (_ (cl-assert (< orig-point (match-end 0))))

 
               (other-end (match-beginning 0))
               (end (match-end 0))
 
               (other-end (match-beginning 0))
               (end (match-end 0))


@@ -1073,12 +1073,12 @@ used to replace chars to try and eliminate some spurious differences."
               (forward-line 1)                            ;Skip hunk header.
               (and (re-search-forward "^[0-9]" nil 'move) ;Skip hunk body.
                    (goto-char (match-beginning 0))))
               (forward-line 1)                            ;Skip hunk header.
               (and (re-search-forward "^[0-9]" nil 'move) ;Skip hunk body.
                    (goto-char (match-beginning 0))))

-            ;; (assert (or (null last1) (< (overlay-start last1) end1)))
-            ;; (assert (or (null last2) (< (overlay-start last2) end2)))
+            ;; (cl-assert (or (null last1) (< (overlay-start last1) end1)))
+            ;; (cl-assert (or (null last2) (< (overlay-start last2) end2)))

             (if smerge-refine-weight-hack
                 (progn
             (if smerge-refine-weight-hack
                 (progn

-                  ;; (assert (or (null last1) (<= (overlay-end last1) end1)))
-                  ;; (assert (or (null last2) (<= (overlay-end last2) end2)))
+                  ;; (cl-assert (or (null last1) (<= (overlay-end last1) end1)))
+                  ;; (cl-assert (or (null last2) (<= (overlay-end last2) end2)))

                   )
               ;; smerge-refine-forward-function when calling in chopup may
               ;; have stopped because it bumped into EOB whereas in
                   )
               ;; smerge-refine-forward-function when calling in chopup may
               ;; have stopped because it bumped into EOB whereas in


@@ -1290,8 +1290,8 @@ with a \\[universal-argument] prefix, makes up a 3-way conflict."
          (progn (pop-mark) (mark))
          (when current-prefix-arg (pop-mark) (mark))))
   ;; Start from the end so as to avoid problems with pos-changes.
          (progn (pop-mark) (mark))
          (when current-prefix-arg (pop-mark) (mark))))
   ;; Start from the end so as to avoid problems with pos-changes.

-  (destructuring-bind (pt1 pt2 pt3 &optional pt4)
-      (sort (list* pt1 pt2 pt3 (if pt4 (list pt4))) '>=)
+  (pcase-let ((`(,pt1 ,pt2 ,pt3 ,pt4)
+               (sort `(,pt1 ,pt2 ,pt3 ,@(if pt4 (list pt4))) '>=)))

     (goto-char pt1) (beginning-of-line)
     (insert ">>>>>>> OTHER\n")
     (goto-char pt2) (beginning-of-line)
     (goto-char pt1) (beginning-of-line)
     (insert ">>>>>>> OTHER\n")
     (goto-char pt2) (beginning-of-line)