[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r108998: Reduce use of (require 'cl).
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r108998: Reduce use of (require 'cl). |
|
Date: |
Tue, 10 Jul 2012 07:51:54 -0400 |
|
User-agent: |
Bazaar (2.5.0) |
------------------------------------------------------------
revno: 108998
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Tue 2012-07-10 07:51:54 -0400
message:
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.
modified:
admin/ChangeLog
admin/bzrmerge.el
leim/ChangeLog
leim/quail/hangul.el
leim/quail/ipa.el
lisp/ChangeLog
lisp/abbrev.el
lisp/apropos.el
lisp/autorevert.el
lisp/avoid.el
lisp/battery.el
lisp/bookmark.el
lisp/bs.el
lisp/calculator.el
lisp/comint.el
lisp/composite.el
lisp/cus-dep.el
lisp/dired.el
lisp/doc-view.el
lisp/edmacro.el
lisp/electric.el
lisp/emacs-lisp/autoload.el
lisp/emacs-lisp/byte-opt.el
lisp/emacs-lisp/bytecomp.el
lisp/emulation/crisp.el
lisp/face-remap.el
lisp/filesets.el
lisp/font-lock.el
lisp/frame.el
lisp/hexl.el
lisp/image-mode.el
lisp/imenu.el
lisp/info-xref.el
lisp/info.el
lisp/international/iso-ascii.el
lisp/international/quail.el
lisp/international/ucs-normalize.el
lisp/jit-lock.el
lisp/loadhist.el
lisp/lpr.el
lisp/minibuffer.el
lisp/mpc.el
lisp/msb.el
lisp/net/dbus.el
lisp/net/gnutls.el
lisp/pcomplete.el
lisp/progmodes/sh-script.el
lisp/register.el
lisp/scroll-bar.el
lisp/simple.el
lisp/uniquify.el
lisp/vc/cvs-status.el
lisp/vc/diff-mode.el
lisp/vc/diff.el
lisp/vc/log-edit.el
lisp/vc/log-view.el
lisp/vc/pcvs-defs.el
lisp/vc/pcvs-info.el
lisp/vc/pcvs-parse.el
lisp/vc/pcvs-util.el
lisp/vc/pcvs.el
lisp/vc/smerge-mode.el
=== modified file 'admin/ChangeLog'
--- a/admin/ChangeLog 2012-07-09 04:52:49 +0000
+++ b/admin/ChangeLog 2012-07-10 11:51:54 +0000
@@ -1,3 +1,7 @@
+2012-07-10 Stefan Monnier <address@hidden>
+
+ * bzrmerge.el: Use cl-lib.
+
2012-07-09 Paul Eggert <address@hidden>
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
- 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 <address@hidden>
@@ -50,9 +54,9 @@
2012-06-13 Andreas Schwab <address@hidden>
- * 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 <address@hidden>
@@ -223,11 +227,11 @@
* 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.
- (../../src/biditype.h, ../../src/bidimirror.h): Deleted.
+ (../../src/biditype.h, ../../src/bidimirror.h): Delete.
2011-07-07 Juanma Barranquero <address@hidden>
@@ -238,8 +242,8 @@
* 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.
@@ -595,13 +599,13 @@
2009-04-17 Kenichi Handa <address@hidden>
- * 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 <address@hidden>
- * 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 <address@hidden>
@@ -1096,7 +1100,7 @@
2005-10-17 Bill Wohler <address@hidden>
- * 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 <address@hidden>
@@ -1143,7 +1147,7 @@
2005-03-30 Marcelo Toledo <address@hidden>
- * 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
=== modified file 'admin/bzrmerge.el'
--- a/admin/bzrmerge.el 2012-05-02 07:12:52 +0000
+++ b/admin/bzrmerge.el 2012-07-10 11:51:54 +0000
@@ -24,8 +24,7 @@
;;; 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\\|\
@@ -256,17 +255,17 @@
;; 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.
- (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))))
- (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
=== modified file 'leim/ChangeLog'
--- a/leim/ChangeLog 2012-06-12 04:35:14 +0000
+++ b/leim/ChangeLog 2012-07-10 11:51:54 +0000
@@ -1,3 +1,9 @@
+2012-07-10 Stefan Monnier <address@hidden>
+
+ * quail/ipa.el: Use cl-lib.
+
+ * quail/hangul.el: Don't require CL.
+
2012-06-12 Nguyen Thai Ngoc Duy <address@hidden>
* quail/vnvi.el: New file (Bug#4747).
=== modified file 'leim/quail/hangul.el'
--- a/leim/quail/hangul.el 2012-01-19 07:21:25 +0000
+++ b/leim/quail/hangul.el 2012-07-10 11:51:54 +0000
@@ -30,7 +30,6 @@
;;; Code:
(require 'quail)
-(eval-when-compile (require 'cl)) ; for setf
(require 'hanja-util)
;; Hangul double Jamo table.
=== modified file 'leim/quail/ipa.el'
--- a/leim/quail/ipa.el 2012-01-19 07:21:25 +0000
+++ b/leim/quail/ipa.el 2012-07-10 11:51:54 +0000
@@ -29,7 +29,7 @@
;;; Code:
(require 'quail)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(quail-define-package
"ipa" "IPA" "IPA" t
@@ -277,13 +277,13 @@
(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)
- (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))))
@@ -318,18 +318,18 @@
(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)
- (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
- (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
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2012-07-10 11:27:27 +0000
+++ b/lisp/ChangeLog 2012-07-10 11:51:54 +0000
@@ -1,5 +1,25 @@
2012-07-10 Stefan Monnier <address@hidden>
+ 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.
=== modified file 'lisp/abbrev.el'
--- a/lisp/abbrev.el 2012-04-23 05:44:49 +0000
+++ b/lisp/abbrev.el 2012-07-10 11:51:54 +0000
@@ -31,7 +31,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defgroup abbrev-mode nil
"Word abbreviations mode."
@@ -540,7 +540,7 @@
(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)))
@@ -583,8 +583,8 @@
\(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))
@@ -621,7 +621,7 @@
(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))
@@ -836,8 +836,7 @@
(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)))
=== modified file 'lisp/apropos.el'
--- a/lisp/apropos.el 2012-04-23 15:38:48 +0000
+++ b/lisp/apropos.el 2012-07-10 11:51:54 +0000
@@ -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.
-;;; 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 fast-command-apropos.
+;; Added fast-command-apropos.
;; 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.
@@ -57,7 +57,6 @@
;;; Code:
(require 'button)
-(eval-when-compile (require 'cl))
(defgroup apropos nil
"Apropos commands for users and programmers."
@@ -640,11 +639,11 @@
(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))
- (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
=== modified file 'lisp/autorevert.el'
--- a/lisp/autorevert.el 2012-04-22 13:58:00 +0000
+++ b/lisp/autorevert.el 2012-07-10 11:51:54 +0000
@@ -94,9 +94,6 @@
(require 'timer)
-(eval-when-compile (require 'cl))
-
-
;; Custom Group:
;;
;; The two modes will be placed next to Auto Save Mode under the
=== modified file 'lisp/avoid.el'
--- a/lisp/avoid.el 2012-04-19 17:20:26 +0000
+++ b/lisp/avoid.el 2012-07-10 11:51:54 +0000
@@ -67,7 +67,7 @@
;;; 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."
@@ -206,30 +206,30 @@
(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
- mouse-avoidance-banish-position 'eq))
+ mouse-avoidance-banish-position #'eq))
(side-dist (assoc-default
'side-pos
- mouse-avoidance-banish-position 'eq))
+ mouse-avoidance-banish-position #'eq))
(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
- 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
=== modified file 'lisp/battery.el'
--- a/lisp/battery.el 2012-04-20 08:48:50 +0000
+++ b/lisp/battery.el 2012-07-10 11:51:54 +0000
@@ -31,8 +31,7 @@
;;; Code:
(require 'timer)
-(eval-when-compile (require 'cl))
-
+(eval-when-compile (require 'cl-lib))
(defgroup battery nil
"Display battery status information."
@@ -360,16 +359,16 @@
(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)
- (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)
- (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)
- (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
=== modified file 'lisp/bookmark.el'
--- a/lisp/bookmark.el 2012-06-27 21:15:13 +0000
+++ b/lisp/bookmark.el 2012-07-10 11:51:54 +0000
@@ -33,7 +33,7 @@
;;; Code:
(require 'pp)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;; Misc comments:
;;
@@ -2015,11 +2015,11 @@
(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
- (t
+ (_
(if (characterp char)
(push char tmp-list)
(setq unread-command-events
@@ -2034,9 +2034,9 @@
(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)))
=== modified file 'lisp/bs.el'
--- a/lisp/bs.el 2012-04-19 16:50:07 +0000
+++ b/lisp/bs.el 2012-07-10 11:51:54 +0000
@@ -124,8 +124,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
;; ----------------------------------------------------------------------
;; Globals for customization
;; ----------------------------------------------------------------------
@@ -830,10 +828,10 @@
(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)))
=== modified file 'lisp/calculator.el'
--- a/lisp/calculator.el 2012-06-02 10:56:09 +0000
+++ b/lisp/calculator.el 2012-07-10 11:51:54 +0000
@@ -43,8 +43,6 @@
;;; History:
;; I hate history.
-(eval-when-compile (require 'cl))
-
;;;=====================================================================
;;; Customization:
=== modified file 'lisp/comint.el'
--- a/lisp/comint.el 2012-07-02 16:18:02 +0000
+++ b/lisp/comint.el 2012-07-10 11:51:54 +0000
@@ -101,7 +101,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'ring)
(require 'ansi-color)
(require 'regexp-opt) ;For regexp-opt-charset.
=== modified file 'lisp/composite.el'
--- a/lisp/composite.el 2012-02-02 09:07:29 +0000
+++ b/lisp/composite.el 2012-07-10 11:51:54 +0000
@@ -29,8 +29,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
(defconst reference-point-alist
'((tl . 0) (tc . 1) (tr . 2)
(Bl . 3) (Bc . 4) (Br . 5)
=== modified file 'lisp/cus-dep.el'
--- a/lisp/cus-dep.el 2012-06-26 16:23:01 +0000
+++ b/lisp/cus-dep.el 2012-07-10 11:51:54 +0000
@@ -25,7 +25,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'widget)
(require 'cus-face)
=== modified file 'lisp/dired.el'
--- a/lisp/dired.el 2012-06-22 07:30:33 +0000
+++ b/lisp/dired.el 2012-07-10 11:51:54 +0000
@@ -34,8 +34,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
;;; Customizable variables
(defgroup dired nil
=== modified file 'lisp/doc-view.el'
--- a/lisp/doc-view.el 2012-06-26 16:23:01 +0000
+++ b/lisp/doc-view.el 2012-07-10 11:51:54 +0000
@@ -133,7 +133,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'dired)
(require 'image-mode)
(require 'jka-compr)
@@ -259,9 +259,9 @@
(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)))
- (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))
@@ -892,30 +892,30 @@
(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))
- (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)))))
- (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))
- (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))
- (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."
@@ -950,14 +950,14 @@
(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)))))
- (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))
@@ -973,11 +973,11 @@
;; 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)))
- (t
+ (_
;; Convert to PNG images.
(doc-view-pdf/ps->png doc-view-buffer-file-name png-file)))))
@@ -1103,7 +1103,7 @@
(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 ()
=== modified file 'lisp/edmacro.el'
--- a/lisp/edmacro.el 2012-06-11 15:52:50 +0000
+++ b/lisp/edmacro.el 2012-07-10 11:51:54 +0000
@@ -63,8 +63,7 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'kmacro)
@@ -319,17 +318,18 @@
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)
- (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))
@@ -437,9 +437,9 @@
(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))
@@ -448,57 +448,58 @@
'(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) " ")
- (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)
- (incf i))
+ (cl-incf i))
(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) ?-)
- (incf i))
+ (cl-incf i))
(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) " ")
- (callf edmacro-subseq rest-mac i)))))))
+ (cl-callf edmacro-subseq rest-mac i)))))))
(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
- (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))
- (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))
- (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)
@@ -509,7 +510,7 @@
(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))))
@@ -535,17 +536,17 @@
(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)
- (case ch2
+ (pcase ch2
(0 "NUL") (9 "TAB") (10 "LFD")
(13 "RET") (27 "ESC") (32 "SPC")
- (t
+ (_
(format "C-%c"
(+ (if (<= ch2 26) 96 64)
ch2)))))
@@ -563,30 +564,30 @@
(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
- (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)))
- (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
- (callf concat res "\n ")
+ (cl-callf concat res "\n ")
(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)
@@ -638,9 +639,9 @@
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)
@@ -655,7 +656,7 @@
((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.
@@ -715,30 +716,31 @@
(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-\^@)))))
- (incf prefix 2)
- (callf substring word 2))
+ (cl-incf prefix 2)
+ (cl-callf substring word 2))
(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)
- (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))
- (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))
@@ -752,7 +754,7 @@
(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) ?\()
@@ -760,13 +762,13 @@
(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)
=== modified file 'lisp/electric.el'
--- a/lisp/electric.el 2012-04-19 22:02:25 +0000
+++ b/lisp/electric.el 2012-07-10 11:51:54 +0000
@@ -38,8 +38,6 @@
;;; 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
@@ -394,16 +392,16 @@
(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.
- (before (goto-char (1- pos)) (skip-chars-backward " \t")
+ (`before (goto-char (1- pos)) (skip-chars-backward " \t")
(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?
=== modified file 'lisp/emacs-lisp/autoload.el'
--- a/lisp/emacs-lisp/autoload.el 2012-06-13 12:46:33 +0000
+++ b/lisp/emacs-lisp/autoload.el 2012-07-10 11:51:54 +0000
@@ -155,13 +155,14 @@
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
=== modified file 'lisp/emacs-lisp/byte-opt.el'
--- a/lisp/emacs-lisp/byte-opt.el 2012-07-02 08:00:05 +0000
+++ b/lisp/emacs-lisp/byte-opt.el 2012-07-10 11:51:54 +0000
@@ -630,10 +630,10 @@
(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.
- ;; (progn (byte-compile-trueconstp (car (last (cdr form)))))
+ ;; (`progn (byte-compile-trueconstp (car (last (cdr form)))))
))
((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)
- (cl-case (car form)
- (quote (null (cadr form)))
+ (pcase (car form)
+ (`quote (null (cadr form)))
;; 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))))
=== modified file 'lisp/emacs-lisp/bytecomp.el'
--- a/lisp/emacs-lisp/bytecomp.el 2012-07-04 14:42:59 +0000
+++ b/lisp/emacs-lisp/bytecomp.el 2012-07-10 11:51:54 +0000
@@ -1591,10 +1591,11 @@
(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))
@@ -2974,12 +2975,12 @@
;; 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))
- (t (push (pop fargs) dynbinds))))
+ (_ (push (pop fargs) dynbinds))))
(unless fmax2 (setq fmax2 (* 2 (length dynbinds)))))
(cond
((<= (+ alen alen) fmax2)
@@ -3024,10 +3025,10 @@
(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)
@@ -4351,21 +4352,21 @@
(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)))))
- (calls
+ (`calls
(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))))))
- (name
+ (`name
(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)
=== modified file 'lisp/emulation/crisp.el'
--- a/lisp/emulation/crisp.el 2012-06-02 10:56:09 +0000
+++ b/lisp/emulation/crisp.el 2012-07-10 11:51:54 +0000
@@ -54,8 +54,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
;; local variables
(defgroup crisp nil
@@ -361,7 +359,7 @@
(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)
=== modified file 'lisp/face-remap.el'
--- a/lisp/face-remap.el 2012-06-17 08:53:31 +0000
+++ b/lisp/face-remap.el 2012-07-10 11:51:54 +0000
@@ -315,9 +315,9 @@
(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".
=== modified file 'lisp/filesets.el'
--- a/lisp/filesets.el 2012-02-28 08:17:21 +0000
+++ b/lisp/filesets.el 2012-07-10 11:51:54 +0000
@@ -88,9 +88,7 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
-
+(eval-when-compile (require 'cl-lib))
;;; Some variables
@@ -1286,11 +1284,11 @@
(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)
@@ -1559,11 +1557,9 @@
(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
@@ -1720,22 +1716,22 @@
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))
- ((:file)
+ (:file
(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))))
- ((:tree)
+ (:tree
(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))
@@ -1904,12 +1900,12 @@
(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)))
-; (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)
@@ -1926,7 +1922,7 @@
`((,(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))
@@ -1952,8 +1948,8 @@
"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)]
@@ -1962,14 +1958,14 @@
,@(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)]))))
- ((:pattern)
+ (:pattern
`("---"
["Close all files" (filesets-close ',mode ',something)]
["Run Command" (filesets-run-cmd nil ',something ',mode)]
@@ -1986,7 +1982,7 @@
,@(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)]
@@ -1997,7 +1993,7 @@
,@(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)
@@ -2249,15 +2245,15 @@
(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)]))
- (t
+ (_
`(,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)))
@@ -2276,7 +2272,7 @@
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: "
@@ -2288,12 +2284,12 @@
,@(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)))
- ((:files)
+ (:files
(let ((files (filesets-get-filelist entry mode 'on-open-all))
(count 0))
`([,(concat "Files: " lookup-name)
@@ -2331,9 +2327,9 @@
(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))
=== modified file 'lisp/font-lock.el'
--- a/lisp/font-lock.el 2012-06-08 16:39:49 +0000
+++ b/lisp/font-lock.el 2012-07-10 11:51:54 +0000
@@ -207,7 +207,7 @@
;;; 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))
@@ -614,9 +614,6 @@
(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.
(defmacro save-buffer-state (&rest body)
@@ -917,10 +914,10 @@
(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)
@@ -1654,7 +1651,7 @@
;; 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))
=== modified file 'lisp/frame.el'
--- a/lisp/frame.el 2012-06-02 10:56:09 +0000
+++ b/lisp/frame.el 2012-07-10 11:51:54 +0000
@@ -25,8 +25,6 @@
;;; Commentary:
;;; Code:
-(eval-when-compile (require 'cl))
-
(defvar frame-creation-function-alist
(list (cons nil
(if (fboundp 'tty-create-frame-with-faces)
=== modified file 'lisp/hexl.el'
--- a/lisp/hexl.el 2012-05-29 09:09:38 +0000
+++ b/lisp/hexl.el 2012-07-10 11:51:54 +0000
@@ -41,7 +41,7 @@
;;; Code:
(require 'eldoc)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl)) ;For letf (default-value 'major-mode).
;;
;; vars here
=== modified file 'lisp/image-mode.el'
--- a/lisp/image-mode.el 2012-05-29 06:16:49 +0000
+++ b/lisp/image-mode.el 2012-07-10 11:51:54 +0000
@@ -34,7 +34,7 @@
;;; Code:
(require 'image)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;; Image mode window-info management.
@@ -70,12 +70,11 @@
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))))
-(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)
@@ -692,20 +691,20 @@
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)
- (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
- (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 =
@@ -743,12 +742,12 @@
(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)
- (assert (= (cdr size)
+ (cl-assert (= (cdr size)
(- (nth 3 (window-inside-pixel-edges))
(nth 1 (window-inside-pixel-edges))))
t))))))
=== modified file 'lisp/imenu.el'
--- a/lisp/imenu.el 2012-05-08 14:19:08 +0000
+++ b/lisp/imenu.el 2012-07-10 11:51:54 +0000
@@ -59,7 +59,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -481,7 +481,7 @@
(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)
@@ -593,17 +593,17 @@
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."
=== modified file 'lisp/info-xref.el'
--- a/lisp/info-xref.el 2012-01-19 07:21:25 +0000
+++ b/lisp/info-xref.el 2012-07-10 11:51:54 +0000
@@ -45,8 +45,7 @@
;;; Code:
(require 'info)
-(eval-when-compile
- (require 'cl)) ;; for `incf'
+(eval-when-compile (require 'cl-lib)) ;; for `incf'
;;-----------------------------------------------------------------------------
;; vaguely generic
@@ -239,11 +238,11 @@
;; 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)
- (incf info-xref-good))
+ (cl-incf info-xref-good))
(t
- (incf info-xref-bad)
+ (cl-incf info-xref-bad)
(info-xref-output-error "no such node: %s" node)))))))
@@ -447,8 +446,8 @@
(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"
=== modified file 'lisp/info.el'
--- a/lisp/info.el 2012-07-08 08:26:21 +0000
+++ b/lisp/info.el 2012-07-10 11:51:54 +0000
@@ -32,8 +32,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
(defgroup info nil
"Info subsystem."
:group 'help
=== modified file 'lisp/international/iso-ascii.el'
--- a/lisp/international/iso-ascii.el 2012-02-08 02:12:24 +0000
+++ b/lisp/international/iso-ascii.el 2012-07-10 11:51:54 +0000
@@ -32,7 +32,6 @@
;;; Code:
(require 'disp-table)
-(eval-when-compile (require 'cl))
(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."
- :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)
=== modified file 'lisp/international/quail.el'
--- a/lisp/international/quail.el 2012-04-10 20:14:33 +0000
+++ b/lisp/international/quail.el 2012-07-10 11:51:54 +0000
@@ -53,7 +53,7 @@
;;; Code:
(require 'help-mode)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defgroup quail nil
"Quail: multilingual input method."
@@ -2395,10 +2395,10 @@
(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))
- (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")
=== modified file 'lisp/international/ucs-normalize.el'
--- a/lisp/international/ucs-normalize.el 2012-01-19 07:21:25 +0000
+++ b/lisp/international/ucs-normalize.el 2012-07-10 11:51:54 +0000
@@ -109,7 +109,7 @@
(defconst ucs-normalize-version "1.2")
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(declare-function nfd "ucs-normalize" (char))
@@ -179,7 +179,7 @@
(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))
@@ -270,7 +270,7 @@
(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
@@ -391,7 +391,7 @@
(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
=== modified file 'lisp/jit-lock.el'
--- a/lisp/jit-lock.el 2012-01-19 07:21:25 +0000
+++ b/lisp/jit-lock.el 2012-07-10 11:51:54 +0000
@@ -29,8 +29,6 @@
(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."
=== modified file 'lisp/loadhist.el'
--- a/lisp/loadhist.el 2012-05-13 03:05:06 +0000
+++ b/lisp/loadhist.el 2012-07-10 11:51:54 +0000
@@ -29,8 +29,6 @@
;;; 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'
@@ -254,11 +252,11 @@
(dolist (x unload-function-defs-list)
(if (consp x)
- (case (car x)
+ (pcase (car x)
;; Remove any feature names that this file provided.
- (provide
+ (`provide
(setq features (delq (cdr x) features)))
- ((defun autoload)
+ ((or `defun `autoload)
(let ((fun (cdr x)))
(when (fboundp fun)
(when (fboundp 'ad-unadvise)
@@ -270,9 +268,9 @@
;; (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
=== modified file 'lisp/lpr.el'
--- a/lisp/lpr.el 2012-01-19 07:21:25 +0000
+++ b/lisp/lpr.el 2012-07-10 11:51:54 +0000
@@ -29,8 +29,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
;;;###autoload
(defvar lpr-windows-system
(memq system-type '(ms-dos windows-nt))
@@ -281,10 +279,10 @@
(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 ": ")
- (t ":\n"))
+ (_ ":\n"))
(buffer-string)))))))
;; This function copies the text between start and end
=== modified file 'lisp/minibuffer.el'
--- a/lisp/minibuffer.el 2012-06-29 06:28:37 +0000
+++ b/lisp/minibuffer.el 2012-07-10 11:51:54 +0000
@@ -81,7 +81,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;; Completion table manipulation
@@ -224,10 +224,10 @@
(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))
@@ -267,7 +267,7 @@
(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.
@@ -300,8 +300,8 @@
(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)))
@@ -408,7 +408,7 @@
(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)))
@@ -418,7 +418,7 @@
(- (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
@@ -466,18 +466,18 @@
(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
- (`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)))
- (`2 ;;all
+ (2 ;;all
(let* ((last (last unquoted-result))
(base (or (cdr last) 0)))
(when last
@@ -527,12 +527,12 @@
(`(,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)))
- (_ (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
@@ -555,11 +555,11 @@
;; 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)))
- (assert
+ (cl-assert
(completion--string-equal-p
(funcall unquote
(concat (substring string 0 qboundary)
@@ -994,9 +994,9 @@
'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
@@ -1041,9 +1041,9 @@
((and completion-cycling completion-all-sorted-completions)
(minibuffer-force-complete)
t)
- (t (case (completion--do-completion)
+ (t (pcase (completion--do-completion)
(#b000 nil)
- (t t)))))
+ (_ t)))))
(defun completion--cache-all-sorted-completions (comps)
(add-hook 'after-change-functions
@@ -1203,15 +1203,15 @@
(t
;; Call do-completion, but ignore errors.
- (case (condition-case nil
+ (pcase (condition-case nil
(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))
- (t nil))))))
+ (_ nil))))))
(defun completion--try-word-completion (string table predicate point md)
(let ((comp (completion-try-completion string table predicate point md)))
@@ -1306,9 +1306,9 @@
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)
- (t t)))
+ (_ t)))
(defface completions-annotations '((t :inherit italic))
"Face to use for annotations in the *Completions* buffer.")
@@ -1555,7 +1555,7 @@
(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)
@@ -1727,7 +1727,7 @@
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.
@@ -1794,7 +1794,7 @@
(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)
@@ -1837,10 +1837,10 @@
;; 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)))
@@ -2046,10 +2046,10 @@
(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
@@ -2074,14 +2074,14 @@
((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))
@@ -2663,7 +2663,7 @@
(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.
@@ -2688,7 +2688,7 @@
(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)
@@ -2762,9 +2762,9 @@
;; 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.
@@ -2828,8 +2828,8 @@
(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)))))
@@ -2928,7 +2928,7 @@
;; `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 "")))))
@@ -2992,11 +2992,11 @@
(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
@@ -3017,15 +3017,17 @@
(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)
- (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)))))
=== modified file 'lisp/mpc.el'
--- a/lisp/mpc.el 2012-04-26 12:43:28 +0000
+++ b/lisp/mpc.el 2012-07-10 11:51:54 +0000
@@ -92,7 +92,7 @@
;; 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)."
@@ -292,7 +292,7 @@
(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 ())
@@ -457,7 +457,7 @@
(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)
@@ -544,7 +544,7 @@
;; (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
@@ -553,7 +553,7 @@
;; (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.
@@ -611,7 +611,7 @@
(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
@@ -827,8 +827,8 @@
(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.
@@ -972,8 +972,8 @@
(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
@@ -981,7 +981,7 @@
(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
@@ -1004,7 +1004,7 @@
(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))
@@ -1222,7 +1222,7 @@
(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)
@@ -1258,7 +1258,7 @@
(> (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)
@@ -1286,12 +1286,12 @@
(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))
- (incf before))
+ (cl-incf before))
(if (and (= after 0) (= before 0))
;; Shortening an already minimum-size region: do nothing.
nil
@@ -1315,13 +1315,13 @@
(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)))
- (incf before))
+ (cl-incf before))
(unless (get-char-property (point) 'mpc-select)
(setq before nil))
(when (and before (or (null count) (< before count)))
@@ -1430,7 +1430,7 @@
(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))
@@ -1916,7 +1916,7 @@
(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")
@@ -2040,7 +2040,7 @@
(- (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"
@@ -2155,12 +2155,12 @@
(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)
- (incf count)))
+ (cl-incf count)))
count))
(defun mpc-songpointer-refresh-hairy ()
@@ -2201,13 +2201,13 @@
((< 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.
- (decf context-size)
+ (cl-decf context-size)
(setq context new-context)
(setq score (mpc-songpointer-score context pos))
(save-excursion
=== modified file 'lisp/msb.el'
--- a/lisp/msb.el 2012-04-09 13:05:48 +0000
+++ b/lisp/msb.el 2012-07-10 11:51:54 +0000
@@ -77,13 +77,13 @@
;; 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
@@ -702,18 +702,18 @@
(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!"))
@@ -817,7 +817,7 @@
(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)")))
@@ -841,18 +841,18 @@
(> 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))
@@ -899,29 +899,29 @@
(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
- (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.
@@ -1039,7 +1039,7 @@
(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
@@ -1076,7 +1076,7 @@
(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)))
=== modified file 'lisp/net/dbus.el'
--- a/lisp/net/dbus.el 2012-06-13 11:56:53 +0000
+++ b/lisp/net/dbus.el 2012-07-10 11:51:54 +0000
@@ -45,8 +45,7 @@
(defvar dbus-registered-objects-table)
;; Pacify byte compiler.
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'xml)
@@ -494,20 +493,20 @@
(dolist (flag flags)
(setq arg
(+ arg
- (case flag
+ (pcase flag
(: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))
- (case reply
+ (pcase reply
(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.
@@ -536,11 +535,11 @@
(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)
- (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)
@@ -803,7 +802,7 @@
;; Service.
(string-equal service (cadr e))
;; Non-empty object path.
- (caddr e)
+ (cl-caddr e)
(throw :found t)))))
dbus-registered-objects-table)
nil))))
@@ -1383,7 +1382,7 @@
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
@@ -1581,7 +1580,7 @@
(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!
=== modified file 'lisp/net/gnutls.el'
--- a/lisp/net/gnutls.el 2012-05-16 02:49:19 +0000
+++ b/lisp/net/gnutls.el 2012-07-10 11:51:54 +0000
@@ -35,7 +35,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defgroup gnutls nil
"Emacs interface to the GnuTLS library."
@@ -120,7 +120,7 @@
(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
=== modified file 'lisp/pcomplete.el'
--- a/lisp/pcomplete.el 2012-04-25 18:53:57 +0000
+++ b/lisp/pcomplete.el 2012-07-10 11:51:54 +0000
@@ -118,7 +118,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'comint)
(defgroup pcomplete nil
@@ -875,9 +874,9 @@
;; 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
@@ -886,9 +885,9 @@
;; 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."
=== modified file 'lisp/progmodes/sh-script.el'
--- a/lisp/progmodes/sh-script.el 2012-05-11 14:24:50 +0000
+++ b/lisp/progmodes/sh-script.el 2012-07-10 11:51:54 +0000
@@ -198,7 +198,7 @@
(eval-when-compile
(require 'skeleton)
- (require 'cl)
+ (require 'cl-lib)
(require 'comint))
(require 'executable)
@@ -987,31 +987,31 @@
(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))
- (?\" (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))))
- (?\` (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)
- (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)))))
@@ -1105,7 +1105,6 @@
(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
@@ -1649,7 +1648,7 @@
(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)
@@ -1661,7 +1660,7 @@
((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)))
=== modified file 'lisp/register.el'
--- a/lisp/register.el 2012-01-19 07:21:25 +0000
+++ b/lisp/register.el 2012-07-10 11:51:54 +0000
@@ -28,7 +28,7 @@
;; 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))
@@ -52,7 +52,7 @@
;;; Code:
-(defstruct
+(cl-defstruct
(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))
-(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.
@@ -150,7 +150,7 @@
(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)))
@@ -325,7 +325,7 @@
(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)))
=== modified file 'lisp/scroll-bar.el'
--- a/lisp/scroll-bar.el 2012-06-22 13:42:38 +0000
+++ b/lisp/scroll-bar.el 2012-07-10 11:51:54 +0000
@@ -29,7 +29,7 @@
;;; Code:
(require 'mouse)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;;; Utilities.
@@ -112,8 +112,9 @@
;; 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).
=== modified file 'lisp/simple.el'
--- a/lisp/simple.el 2012-07-08 06:09:21 +0000
+++ b/lisp/simple.el 2012-07-10 11:51:54 +0000
@@ -28,8 +28,6 @@
;;; Code:
-(eval-when-compile (require 'cl)) ;For define-minor-mode.
-
(declare-function widget-convert "wid-edit" (type &rest args))
(declare-function shell-mode "shell" ())
=== modified file 'lisp/uniquify.el'
--- a/lisp/uniquify.el 2012-01-19 07:21:25 +0000
+++ b/lisp/uniquify.el 2012-07-10 11:51:54 +0000
@@ -83,7 +83,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;; User-visible variables
@@ -174,7 +174,7 @@
;;; 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)))
@@ -340,7 +340,7 @@
(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
=== modified file 'lisp/vc/cvs-status.el'
--- a/lisp/vc/cvs-status.el 2012-04-09 13:05:48 +0000
+++ b/lisp/vc/cvs-status.el 2012-07-10 11:51:54 +0000
@@ -28,7 +28,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'pcvs-util)
;;;
@@ -165,7 +165,7 @@
;; Tagelt, tag element
;;
-(defstruct (cvs-tag
+(cl-defstruct (cvs-tag
(:constructor nil)
(:constructor cvs-tag-make
(vlist &optional name type))
@@ -235,9 +235,9 @@
(save-excursion
(or (= (forward-line 1) 0) (insert "\n"))
(cvs-tree-print rest printer column))))
- (assert (>= prefix column))
+ (cl-assert (>= prefix column))
(move-to-column prefix t)
- (assert (eolp))
+ (cl-assert (eolp))
(insert (cvs-car name))
(dolist (br (cvs-cdr rev))
(let* ((column (current-column))
@@ -258,7 +258,7 @@
(defun cvs-tree-merge (tree1 tree2)
"Merge tags trees TREE1 and TREE2 into one.
BEWARE: because of stability issues, this is not a symmetric operation."
- (assert (and (listp tree1) (listp tree2)))
+ (cl-assert (and (listp tree1) (listp tree2)))
(cond
((null tree1) tree2)
((null tree2) tree1)
@@ -273,10 +273,10 @@
(l2 (length vl2)))
(cond
((= l1 l2)
- (case (cvs-tag-compare tag1 tag2)
- (more1 (list* rev2 (cvs-tree-merge tree1 (cdr tree2))))
- (more2 (list* rev1 (cvs-tree-merge (cdr tree1) tree2)))
- (equal
+ (pcase (cvs-tag-compare tag1 tag2)
+ (`more1 (cons rev2 (cvs-tree-merge tree1 (cdr tree2))))
+ (`more2 (cons rev1 (cvs-tree-merge (cdr tree1) tree2)))
+ (`equal
(cons (cons (cvs-tag-merge tag1 tag2)
(cvs-tree-merge (cvs-cdr rev1) (cvs-cdr rev2)))
(cvs-tree-merge (cdr tree1) (cdr tree2))))))
@@ -399,35 +399,35 @@
Otherwise, default to ASCII chars like +, - and |.")
(defconst cvs-tree-char-space
- (case cvs-tree-use-charset
- (jisx0208 (make-char 'japanese-jisx0208 33 33))
- (unicode " ")
- (t " ")))
+ (pcase cvs-tree-use-charset
+ (`jisx0208 (make-char 'japanese-jisx0208 33 33))
+ (`unicode " ")
+ (_ " ")))
(defconst cvs-tree-char-hbar
- (case cvs-tree-use-charset
- (jisx0208 (make-char 'japanese-jisx0208 40 44))
- (unicode "━")
- (t "--")))
+ (pcase cvs-tree-use-charset
+ (`jisx0208 (make-char 'japanese-jisx0208 40 44))
+ (`unicode "━")
+ (_ "--")))
(defconst cvs-tree-char-vbar
- (case cvs-tree-use-charset
- (jisx0208 (make-char 'japanese-jisx0208 40 45))
- (unicode "┃")
- (t "| ")))
+ (pcase cvs-tree-use-charset
+ (`jisx0208 (make-char 'japanese-jisx0208 40 45))
+ (`unicode "┃")
+ (_ "| ")))
(defconst cvs-tree-char-branch
- (case cvs-tree-use-charset
- (jisx0208 (make-char 'japanese-jisx0208 40 50))
- (unicode "┣")
- (t "+-")))
+ (pcase cvs-tree-use-charset
+ (`jisx0208 (make-char 'japanese-jisx0208 40 50))
+ (`unicode "┣")
+ (_ "+-")))
(defconst cvs-tree-char-eob ;end of branch
- (case cvs-tree-use-charset
- (jisx0208 (make-char 'japanese-jisx0208 40 49))
- (unicode "┗")
- (t "`-")))
+ (pcase cvs-tree-use-charset
+ (`jisx0208 (make-char 'japanese-jisx0208 40 49))
+ (`unicode "┗")
+ (_ "`-")))
(defconst cvs-tree-char-bob ;beginning of branch
- (case cvs-tree-use-charset
- (jisx0208 (make-char 'japanese-jisx0208 40 51))
- (unicode "┳")
- (t "+-")))
+ (pcase cvs-tree-use-charset
+ (`jisx0208 (make-char 'japanese-jisx0208 40 51))
+ (`unicode "┳")
+ (_ "+-")))
(defun cvs-tag-lessp (tag1 tag2)
(eq (cvs-tag-compare tag1 tag2) 'more2))
@@ -485,9 +485,9 @@
(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))
=== modified file 'lisp/vc/diff-mode.el'
--- a/lisp/vc/diff-mode.el 2012-06-29 06:28:37 +0000
+++ b/lisp/vc/diff-mode.el 2012-07-10 11:51:54 +0000
@@ -53,7 +53,7 @@
;; - Handle `diff -b' output in context->unified.
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defvar add-log-buffer-file-name-function)
@@ -493,14 +493,15 @@
;; We may have a first evaluation of `end' thanks to the hunk header.
(unless end
(setq end (and (re-search-forward
- (case style
- (unified (concat (if diff-valid-unified-empty-line
- "^[^-+# \\\n]\\|" "^[^-+# \\]\\|")
- ;; A `unified' header is ambiguous.
- diff-file-header-re))
- (context "^[^-+#! \\]")
- (normal "^[^<>#\\]")
- (t "^[^-+#!<> \\]"))
+ (pcase style
+ (`unified
+ (concat (if diff-valid-unified-empty-line
+ "^[^-+# \\\n]\\|" "^[^-+# \\]\\|")
+ ;; A `unified' header is ambiguous.
+ diff-file-header-re))
+ (`context "^[^-+#! \\]")
+ (`normal "^[^<>#\\]")
+ (_ "^[^-+#!<> \\]"))
nil t)
(match-beginning 0)))
(when diff-valid-unified-empty-line
@@ -710,7 +711,7 @@
(save-excursion
(let ((n 0))
(goto-char start)
- (while (re-search-forward re end t) (incf n))
+ (while (re-search-forward re end t) (cl-incf n))
n)))
(defun diff-splittable-p ()
@@ -834,16 +835,16 @@
;; use any previously used preference
(cdr (assoc fs diff-remembered-files-alist))
;; try to be clever and use previous choices as an inspiration
- (dolist (rf diff-remembered-files-alist)
+ (cl-dolist (rf diff-remembered-files-alist)
(let ((newfile (diff-merge-strings (caar rf) (car fs) (cdr rf))))
- (if (and newfile (file-exists-p newfile)) (return newfile))))
+ (if (and newfile (file-exists-p newfile)) (cl-return newfile))))
;; look for each file in turn. If none found, try again but
;; ignoring the first level of directory, ...
- (do* ((files fs (delq nil (mapcar 'diff-filename-drop-dir files)))
- (file nil nil))
+ (cl-do* ((files fs (delq nil (mapcar 'diff-filename-drop-dir files)))
+ (file nil nil))
((or (null files)
- (setq file (do* ((files files (cdr files))
- (file (car files) (car files)))
+ (setq file (cl-do* ((files files (cdr files))
+ (file (car files) (car files)))
;; Use file-regular-p to avoid
;; /dev/null, directories, etc.
((or (null file) (file-regular-p file))
@@ -862,7 +863,7 @@
(diff-find-file-name old noprompt (match-string 1)))
;; if all else fails, ask the user
(unless noprompt
- (let ((file (expand-file-name (or (first fs) ""))))
+ (let ((file (expand-file-name (or (car fs) ""))))
(setq file
(read-file-name (format "Use file %s: " file)
(file-name-directory file) file t
@@ -940,21 +941,23 @@
(let ((modif nil) last-pt)
(while (progn (setq last-pt (point))
(= (forward-line -1) 0))
- (case (char-after)
+ (pcase (char-after)
(?\s (insert " ") (setq modif nil) (backward-char 1))
(?+ (delete-region (point) last-pt) (setq modif t))
(?- (if (not modif)
- (progn (forward-char 1)
- (insert " "))
- (delete-char 1)
- (insert "! "))
- (backward-char 2))
+ (progn (forward-char 1)
+ (insert " "))
+ (delete-char 1)
+ (insert "! "))
+ (backward-char 2))
(?\\ (when (save-excursion (forward-line -1)
- (= (char-after) ?+))
- (delete-region (point) last-pt) (setq modif
t)))
+ (= (char-after) ?+))
+ (delete-region (point) last-pt)
+ (setq modif t)))
;; diff-valid-unified-empty-line.
- (?\n (insert " ") (setq modif nil) (backward-char
2))
- (t (setq modif nil))))))
+ (?\n (insert " ") (setq modif nil)
+ (backward-char 2))
+ (_ (setq modif nil))))))
(goto-char (point-max))
(save-excursion
(insert "--- " line2 ","
@@ -967,7 +970,8 @@
(if (not (save-excursion (re-search-forward "^+" nil t)))
(delete-region (point) (point-max))
(let ((modif nil) (delete nil))
- (if (save-excursion (re-search-forward "^\\+.*\n-" nil t))
+ (if (save-excursion (re-search-forward "^\\+.*\n-"
+ nil t))
;; Normally, lines in a substitution come with
;; first the removals and then the additions, and
;; the context->unified function follows this
@@ -976,22 +980,22 @@
;; context->unified as an undo command.
(setq reversible nil))
(while (not (eobp))
- (case (char-after)
+ (pcase (char-after)
(?\s (insert " ") (setq modif nil) (backward-char 1))
(?- (setq delete t) (setq modif t))
(?+ (if (not modif)
- (progn (forward-char 1)
- (insert " "))
- (delete-char 1)
- (insert "! "))
- (backward-char 2))
+ (progn (forward-char 1)
+ (insert " "))
+ (delete-char 1)
+ (insert "! "))
+ (backward-char 2))
(?\\ (when (save-excursion (forward-line 1)
- (not (eobp)))
- (setq delete t) (setq modif t)))
+ (not (eobp)))
+ (setq delete t) (setq modif t)))
;; diff-valid-unified-empty-line.
(?\n (insert " ") (setq modif nil) (backward-char 2)
(setq reversible nil))
- (t (setq modif nil)))
+ (_ (setq modif nil)))
(let ((last-pt (point)))
(forward-line 1)
(when delete
@@ -1051,17 +1055,18 @@
(goto-char pt1)
(forward-line 1)
(while (< (point) pt2)
- (case (char-after)
+ (pcase (char-after)
(?! (delete-char 2) (insert "-") (forward-line 1))
(?- (forward-char 1) (delete-char 1) (forward-line 1))
- (?\s ;merge with the other half of the chunk
+ (?\s ;merge with the other half of the chunk
(let* ((endline2
(save-excursion
(goto-char pt2) (forward-line 1) (point))))
- (case (char-after pt2)
- ((?! ?+)
+ (pcase (char-after pt2)
+ ((or ?! ?+)
(insert "+"
- (prog1 (buffer-substring (+ pt2 2)
endline2)
+ (prog1
+ (buffer-substring (+ pt2 2) endline2)
(delete-region pt2 endline2))))
(?\s
(unless (= (- endline2 pt2)
@@ -1075,9 +1080,9 @@
(delete-char 1)
(forward-line 1))
(?\\ (forward-line 1))
- (t (setq reversible nil)
+ (_ (setq reversible nil)
(delete-char 1) (forward-line 1)))))
- (t (setq reversible nil) (forward-line 1))))
+ (_ (setq reversible nil) (forward-line 1))))
(while (looking-at "[+! ] ")
(if (/= (char-after) ?!) (forward-char 1)
(delete-char 1) (insert "+"))
@@ -1155,13 +1160,13 @@
(replace-match "@@ -\\8 +\\7 @@" nil)
(forward-line 1)
(let ((c (char-after)) first last)
- (while (case (setq c (char-after))
+ (while (pcase (setq c (char-after))
(?- (setq first (or first (point)))
- (delete-char 1) (insert "+") t)
+ (delete-char 1) (insert "+") t)
(?+ (setq last (or last (point)))
- (delete-char 1) (insert "-") t)
- ((?\\ ?#) t)
- (t (when (and first last (< first last))
+ (delete-char 1) (insert "-") t)
+ ((or ?\\ ?#) t)
+ (_ (when (and first last (< first last))
(insert (delete-and-extract-region first last)))
(setq first nil last nil)
(memq c (if diff-valid-unified-empty-line
@@ -1184,13 +1189,13 @@
(concat diff-hunk-header-re-unified
"\\|[-*][-*][-*] [0-9,]+ [-*][-*][-*][-*]$"
"\\|--- .+\n\\+\\+\\+ ")))
- (case (char-after)
- (?\s (incf space))
- (?+ (incf plus))
- (?- (incf minus))
- (?! (incf bang))
- ((?\\ ?#) nil)
- (t (setq space 0 plus 0 minus 0 bang 0)))
+ (pcase (char-after)
+ (?\s (cl-incf space))
+ (?+ (cl-incf plus))
+ (?- (cl-incf minus))
+ (?! (cl-incf bang))
+ ((or ?\\ ?#) nil)
+ (_ (setq space 0 plus 0 minus 0 bang 0)))
(cond
((looking-at diff-hunk-header-re-unified)
(let* ((old1 (match-string 2))
@@ -1432,7 +1437,7 @@
(cond
((and (memq (char-after) '(?\s ?! ?+ ?-))
(memq (char-after (1+ (point))) '(?\s ?\t)))
- (decf count) t)
+ (cl-decf count) t)
((or (zerop count) (= count lines)) nil)
((memq (char-after) '(?! ?+ ?-))
(if (not (and (eq (char-after (1+ (point))) ?\n)
@@ -1483,8 +1488,8 @@
(after (string-to-number (or (match-string 4) "1"))))
(forward-line)
(while
- (case (char-after)
- (?\s (decf before) (decf after) t)
+ (pcase (char-after)
+ (?\s (cl-decf before) (cl-decf after) t)
(?-
(if (and (looking-at diff-file-header-re)
(zerop before) (zerop after))
@@ -1494,15 +1499,15 @@
;; line so that our code which doesn't count lines
;; will not get confused.
(progn (save-excursion (insert "\n")) nil)
- (decf before) t))
- (?+ (decf after) t)
- (t
+ (cl-decf before) t))
+ (?+ (cl-decf after) t)
+ (_
(cond
((and diff-valid-unified-empty-line
;; Not just (eolp) so we don't infloop at eob.
(eq (char-after) ?\n)
(> before 0) (> after 0))
- (decf before) (decf after) t)
+ (cl-decf before) (cl-decf after) t)
((and (zerop before) (zerop after)) nil)
((or (< before 0) (< after 0))
(error (if (or (zerop before) (zerop after))
@@ -1719,16 +1724,17 @@
With a prefix argument, REVERSE the hunk."
(interactive "P")
- (destructuring-bind (buf line-offset pos old new &optional switched)
- ;; Sometimes we'd like to have the following behavior: if REVERSE go
- ;; to the new file, otherwise go to the old. But that means that by
- ;; default we use the old file, which is the opposite of the default
- ;; for diff-goto-source, and is thus confusing. Also when you don't
- ;; know about it it's pretty surprising.
- ;; TODO: make it possible to ask explicitly for this behavior.
- ;;
- ;; This is duplicated in diff-test-hunk.
- (diff-find-source-location nil reverse)
+ (pcase-let ((`(,buf ,line-offset ,pos ,old ,new ,switched)
+ ;; Sometimes we'd like to have the following behavior: if
+ ;; REVERSE go to the new file, otherwise go to the old.
+ ;; But that means that by default we use the old file, which is
+ ;; the opposite of the default for diff-goto-source, and is thus
+ ;; confusing. Also when you don't know about it it's
+ ;; pretty surprising.
+ ;; TODO: make it possible to ask explicitly for this behavior.
+ ;;
+ ;; This is duplicated in diff-test-hunk.
+ (diff-find-source-location nil reverse)))
(cond
((null line-offset)
(error "Can't find the text to patch"))
@@ -1771,8 +1777,8 @@
"See whether it's possible to apply the current hunk.
With a prefix argument, try to REVERSE the hunk."
(interactive "P")
- (destructuring-bind (buf line-offset pos src _dst &optional switched)
- (diff-find-source-location nil reverse)
+ (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched)
+ (diff-find-source-location nil reverse)))
(set-window-point (display-buffer buf) (+ (car pos) (cdr src)))
(diff-hunk-status-msg line-offset (diff-xor reverse switched) t)))
@@ -1791,8 +1797,8 @@
;; This is a convenient detail when using smerge-diff.
(if event (posn-set-point (event-end event)))
(let ((rev (not (save-excursion (beginning-of-line) (looking-at "[-<]")))))
- (destructuring-bind (buf line-offset pos src _dst &optional switched)
- (diff-find-source-location other-file rev)
+ (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched)
+ (diff-find-source-location other-file rev)))
(pop-to-buffer buf)
(goto-char (+ (car pos) (cdr src)))
(diff-hunk-status-msg line-offset (diff-xor rev switched) t))))
@@ -1809,10 +1815,11 @@
(when (looking-at diff-hunk-header-re)
(forward-line 1)
(re-search-forward "^[^ ]" nil t))
- (destructuring-bind (&optional buf _line-offset pos src dst switched)
- ;; Use `noprompt' since this is used in which-func-mode and such.
- (ignore-errors ;Signals errors in place of prompting.
- (diff-find-source-location nil nil 'noprompt))
+ (pcase-let ((`(,buf ,_line-offset ,pos ,src ,dst ,switched)
+ (ignore-errors ;Signals errors in place of prompting.
+ ;; Use `noprompt' since this is used in which-func-mode
+ ;; and such.
+ (diff-find-source-location nil nil 'noprompt))))
(when buf
(beginning-of-line)
(or (when (memq (char-after) '(?< ?-))
@@ -1835,7 +1842,7 @@
"Re-diff the current hunk, ignoring whitespace differences."
(interactive)
(let* ((char-offset (- (point) (diff-beginning-of-hunk t)))
- (opts (case (char-after) (?@ "-bu") (?* "-bc") (t "-b")))
+ (opts (pcase (char-after) (?@ "-bu") (?* "-bc") (_ "-b")))
(line-nb (and (or (looking-at "[^0-9]+\\([0-9]+\\)")
(error "Can't find line number"))
(string-to-number (match-string 1))))
@@ -1857,13 +1864,13 @@
(let ((status
(call-process diff-command nil t nil
opts file1 file2)))
- (case status
- (0 nil) ;Nothing to reformat.
+ (pcase status
+ (0 nil) ;Nothing to reformat.
(1 (goto-char (point-min))
- ;; Remove the file-header.
- (when (re-search-forward diff-hunk-header-re nil t)
- (delete-region (point-min) (match-beginning 0))))
- (t (goto-char (point-max))
+ ;; Remove the file-header.
+ (when (re-search-forward diff-hunk-header-re nil t)
+ (delete-region (point-min) (match-beginning 0))))
+ (_ (goto-char (point-max))
(unless (bolp) (insert "\n"))
(insert hunk)))
(setq hunk (buffer-string))
@@ -1942,14 +1949,14 @@
(remove-overlays beg end 'diff-mode 'fine)
(goto-char beg)
- (case style
- (unified
+ (pcase style
+ (`unified
(while (re-search-forward "^\\(?:-.*\n\\)+\\(\\)\\(?:\\+.*\n\\)+"
end t)
(smerge-refine-subst (match-beginning 0) (match-end 1)
(match-end 1) (match-end 0)
nil 'diff-refine-preproc props-r props-a)))
- (context
+ (`context
(let* ((middle (save-excursion (re-search-forward "^---")))
(other middle))
(while (re-search-forward "^\\(?:!.*\n\\)+" middle t)
@@ -1964,7 +1971,7 @@
'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.
=== modified file 'lisp/vc/diff.el'
--- a/lisp/vc/diff.el 2012-04-27 14:16:02 +0000
+++ b/lisp/vc/diff.el 2012-07-10 11:51:54 +0000
@@ -32,8 +32,6 @@
(declare-function diff-setup-whitespace "diff-mode" ())
-(eval-when-compile (require 'cl))
-
(defgroup diff nil
"Comparing files with `diff'."
:group 'tools)
=== modified file 'lisp/vc/log-edit.el'
--- a/lisp/vc/log-edit.el 2012-05-13 03:05:06 +0000
+++ b/lisp/vc/log-edit.el 2012-07-10 11:51:54 +0000
@@ -29,7 +29,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'add-log) ; for all the ChangeLog goodies
(require 'pcvs-util)
(require 'ring)
=== modified file 'lisp/vc/log-view.el'
--- a/lisp/vc/log-view.el 2012-02-11 23:02:29 +0000
+++ b/lisp/vc/log-view.el 2012-07-10 11:51:54 +0000
@@ -109,7 +109,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'pcvs-util)
(autoload 'vc-find-revision "vc")
(autoload 'vc-diff-internal "vc")
=== modified file 'lisp/vc/pcvs-defs.el'
--- a/lisp/vc/pcvs-defs.el 2012-04-09 13:05:48 +0000
+++ b/lisp/vc/pcvs-defs.el 2012-07-10 11:51:54 +0000
@@ -26,7 +26,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'pcvs-util)
;;;; -------------------------------------------------------
=== modified file 'lisp/vc/pcvs-info.el'
--- a/lisp/vc/pcvs-info.el 2012-01-19 07:21:25 +0000
+++ b/lisp/vc/pcvs-info.el 2012-07-10 11:51:54 +0000
@@ -31,7 +31,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'pcvs-util)
;;(require 'pcvs-defs)
@@ -146,7 +146,7 @@
;; Constructor:
-(defstruct (cvs-fileinfo
+(cl-defstruct (cvs-fileinfo
(:constructor nil)
(:copier nil)
(:constructor -cvs-create-fileinfo (type dir file full-log
@@ -274,10 +274,10 @@
(string= file (file-name-nondirectory file)))
(setq check 'type) (symbolp type)
(setq check 'consistency)
- (case type
- (DIRCHANGE (and (null subtype) (string= "." file)))
- ((NEED-UPDATE ADDED MISSING DEAD MODIFIED MESSAGE UP-TO-DATE
- REMOVED NEED-MERGE CONFLICT UNKNOWN MESSAGE)
+ (pcase type
+ (`DIRCHANGE (and (null subtype) (string= "." file)))
+ ((or `NEED-UPDATE `ADDED `MISSING `DEAD `MODIFIED `MESSAGE
+ `UP-TO-DATE `REMOVED `NEED-MERGE `CONFLICT `UNKNOWN)
t)))
fi
(error "Invalid :%s in cvs-fileinfo %s" check fi))))
@@ -325,9 +325,9 @@
(defun cvs-add-face (str face &optional keymap &rest props)
(when keymap
(when (keymapp keymap)
- (setq props (list* 'keymap keymap props)))
- (setq props (list* 'mouse-face 'highlight props)))
- (add-text-properties 0 (length str) (list* 'font-lock-face face props) str)
+ (setq props `(keymap ,keymap ,@props)))
+ (setq props `(mouse-face highlight ,@props)))
+ (add-text-properties 0 (length str) `(font-lock-face ,face ,@props) str)
str)
(defun cvs-fileinfo-pp (fileinfo)
@@ -337,15 +337,15 @@
(let ((type (cvs-fileinfo->type fileinfo))
(subtype (cvs-fileinfo->subtype fileinfo)))
(insert
- (case type
- (DIRCHANGE (concat "In directory "
- (cvs-add-face (cvs-fileinfo->full-name fileinfo)
- 'cvs-header t 'cvs-goal-column t)
- ":"))
- (MESSAGE
+ (pcase type
+ (`DIRCHANGE (concat "In directory "
+ (cvs-add-face (cvs-fileinfo->full-name fileinfo)
+ 'cvs-header t 'cvs-goal-column t)
+ ":"))
+ (`MESSAGE
(cvs-add-face (format "Message: %s" (cvs-fileinfo->full-log fileinfo))
'cvs-msg))
- (t
+ (_
(let* ((status (if (cvs-fileinfo->marked fileinfo)
(cvs-add-face "*" 'cvs-marked)
" "))
@@ -354,10 +354,10 @@
(base (or (cvs-fileinfo->base-rev fileinfo) ""))
(head (cvs-fileinfo->head-rev fileinfo))
(type
- (let ((str (case type
+ (let ((str (pcase type
;;(MOD-CONFLICT "Not Removed")
- (DEAD "")
- (t (capitalize (symbol-name type)))))
+ (`DEAD "")
+ (_ (capitalize (symbol-name type)))))
(face (let ((sym (intern
(concat "cvs-fi-"
(downcase (symbol-name type))
=== modified file 'lisp/vc/pcvs-parse.el'
--- a/lisp/vc/pcvs-parse.el 2012-01-19 07:21:25 +0000
+++ b/lisp/vc/pcvs-parse.el 2012-07-10 11:51:54 +0000
@@ -32,8 +32,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
(require 'pcvs-util)
(require 'pcvs-info)
@@ -117,7 +115,7 @@
then assign the variables as specified in MATCHES (via `setq')."
(cons 'cvs-do-match
(cons re (mapcar (lambda (match)
- `(cons ',(first match) ,(second match)))
+ `(cons ',(car match) ,(cadr match)))
matches))))
(defun cvs-do-match (re &rest matches)
@@ -150,8 +148,8 @@
(cvs-or
(funcall parse-spec)
- (dolist (re cvs-parse-ignored-messages)
- (when (cvs-match re) (return t)))
+ (cl-dolist (re cvs-parse-ignored-messages)
+ (when (cvs-match re) (cl-return t)))
;; This is a parse error. Create a message-type fileinfo.
(and
@@ -221,7 +219,7 @@
;; ?: Unknown file.
(let ((code (aref c 0)))
(cvs-parsed-fileinfo
- (case code
+ (pcase code
(?M 'MODIFIED)
(?A 'ADDED)
(?R 'REMOVED)
@@ -238,7 +236,7 @@
(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)))
=== modified file 'lisp/vc/pcvs-util.el'
--- a/lisp/vc/pcvs-util.el 2012-04-16 23:57:09 +0000
+++ b/lisp/vc/pcvs-util.el 2012-07-10 11:51:54 +0000
@@ -26,7 +26,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;;;
;;;; list processing
@@ -63,7 +63,7 @@
(while (and l (> n 1))
(setcdr nl (list (pop l)))
(setq nl (cdr nl))
- (decf n))
+ (cl-decf n))
ret))))
(defun cvs-partition (p l)
@@ -130,10 +130,10 @@
(if noreuse (generate-new-buffer name)
(get-buffer-create name)))
(unless noreuse
- (dolist (buf (buffer-list))
+ (cl-dolist (buf (buffer-list))
(with-current-buffer buf
(when (equal name list-buffers-directory)
- (return buf)))))
+ (cl-return buf)))))
(with-current-buffer (create-file-buffer name)
(setq list-buffers-directory name)
(current-buffer))))
@@ -195,10 +195,10 @@
;;;; (interactive <foo>) support function
;;;;
-(defstruct (cvs-qtypedesc
- (:constructor nil) (:copier nil)
- (:constructor cvs-qtypedesc-create
- (str2obj obj2str &optional complete hist-sym
require)))
+(cl-defstruct (cvs-qtypedesc
+ (:constructor nil) (:copier nil)
+ (:constructor cvs-qtypedesc-create
+ (str2obj obj2str &optional complete hist-sym require)))
str2obj
obj2str
hist-sym
@@ -231,10 +231,10 @@
;;;; 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
=== modified file 'lisp/vc/pcvs.el'
--- a/lisp/vc/pcvs.el 2012-06-23 15:38:23 +0000
+++ b/lisp/vc/pcvs.el 2012-07-10 11:51:54 +0000
@@ -118,7 +118,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'ewoc) ;Ewoc was once cookie
(require 'pcvs-defs)
(require 'pcvs-util)
@@ -219,21 +219,21 @@
(autoload 'cvs-status-get-tags "cvs-status")
(defun cvs-tags-list ()
"Return a list of acceptable tags, ready for completions."
- (assert (cvs-buffer-p))
+ (cl-assert (cvs-buffer-p))
(let ((marked (cvs-get-marked)))
- (list* '("BASE") '("HEAD")
- (when marked
- (with-temp-buffer
- (process-file cvs-program
- nil ;no input
- t ;output to current-buffer
- nil ;don't update display while running
- "status"
- "-v"
- (cvs-fileinfo->full-name (car marked)))
- (goto-char (point-min))
- (let ((tags (cvs-status-get-tags)))
- (when (listp tags) tags)))))))
+ `(("BASE") ("HEAD")
+ ,@(when marked
+ (with-temp-buffer
+ (process-file cvs-program
+ nil ;no input
+ t ;output to current-buffer
+ nil ;don't update display while running
+ "status"
+ "-v"
+ (cvs-fileinfo->full-name (car marked)))
+ (goto-char (point-min))
+ (let ((tags (cvs-status-get-tags)))
+ (when (listp tags) tags)))))))
(defvar cvs-tag-history nil)
(defconst cvs-qtypedesc-tag
@@ -426,16 +426,16 @@
;; look for another cvs buffer visiting the same directory
(save-excursion
(unless new
- (dolist (buffer (cons (current-buffer) (buffer-list)))
+ (cl-dolist (buffer (cons (current-buffer) (buffer-list)))
(set-buffer buffer)
(and (cvs-buffer-p)
- (case cvs-reuse-cvs-buffer
- (always t)
- (subdir
+ (pcase cvs-reuse-cvs-buffer
+ (`always t)
+ (`subdir
(or (string-prefix-p default-directory dir)
(string-prefix-p dir default-directory)))
- (samedir (string= default-directory dir)))
- (return buffer)))))
+ (`samedir (string= default-directory dir)))
+ (cl-return buffer)))))
;; we really have to create a new buffer:
;; we temporarily bind cwd to "" to prevent
;; create-file-buffer from using directory info
@@ -478,7 +478,7 @@
;;(set-buffer buf)
buffer))))))
-(defun* cvs-cmd-do (cmd dir flags fis new
+(cl-defun cvs-cmd-do (cmd dir flags fis new
&key cvsargs noexist dont-change-disc noshow)
(let* ((dir (file-name-as-directory
(abbreviate-file-name (expand-file-name dir))))
@@ -501,7 +501,7 @@
;; cvsbuf))))
(defun cvs-run-process (args fis postprocess &optional single-dir)
- (assert (cvs-buffer-p cvs-buffer))
+ (cl-assert (cvs-buffer-p cvs-buffer))
(save-current-buffer
(let ((procbuf (current-buffer))
(cvsbuf cvs-buffer)
@@ -521,9 +521,9 @@
(let ((inhibit-read-only t))
(insert "pcl-cvs: descending directory " dir "\n"))
;; loop to find the same-dir-elems
- (do* ((files () (cons (cvs-fileinfo->file fi) files))
- (fis fis (cdr fis))
- (fi (car fis) (car fis)))
+ (cl-do* ((files () (cons (cvs-fileinfo->file fi) files))
+ (fis fis (cdr fis))
+ (fi (car fis) (car fis)))
((not (and fis (string= dir (cvs-fileinfo->dir fi))))
(list dir files fis))))))
(dir (nth 0 dir+files+rest))
@@ -813,7 +813,7 @@
(while (and tin (cvs-fileinfo< fi (ewoc-data tin)))
(setq tin (ewoc-prev c tin)))
(if (null tin) (ewoc-enter-first c fi) ;empty collection
- (assert (not (cvs-fileinfo< fi (ewoc-data tin))))
+ (cl-assert (not (cvs-fileinfo< fi (ewoc-data tin))))
(let ((next-tin (ewoc-next c tin)))
(while (not (or (null next-tin)
(cvs-fileinfo< fi (ewoc-data next-tin))))
@@ -871,15 +871,15 @@
(let* ((type (cvs-fileinfo->type fi))
(subtype (cvs-fileinfo->subtype fi))
(keep
- (case type
+ (pcase type
;; remove temp messages and keep the others
- (MESSAGE (not (or rm-msgs (eq subtype 'TEMP))))
+ (`MESSAGE (not (or rm-msgs (eq subtype 'TEMP))))
;; remove entries
- (DEAD nil)
+ (`DEAD nil)
;; handled also?
- (UP-TO-DATE (not rm-handled))
+ (`UP-TO-DATE (not rm-handled))
;; keep the rest
- (t (not (run-hook-with-args-until-success
+ (_ (not (run-hook-with-args-until-success
'cvs-cleanup-functions fi))))))
;; mark dirs for removal
@@ -1389,7 +1389,7 @@
fis))))
(nreverse fis)))
-(defun* cvs-mode-marked (filter &optional cmd
+(cl-defun cvs-mode-marked (filter &optional cmd
&key read-only one file noquery)
"Get the list of marked FIS.
CMD is used to determine whether to use the marks or not.
@@ -1474,7 +1474,7 @@
(let ((msg (buffer-substring-no-properties (point-min) (point-max))))
(cvs-mode!)
;;(pop-to-buffer cvs-buffer)
- (cvs-mode-do "commit" (list* "-m" msg flags) 'commit)))
+ (cvs-mode-do "commit" `("-m" ,msg ,@flags) 'commit)))
;;;; Editing existing commit log messages.
@@ -1604,7 +1604,7 @@
(or current-prefix-arg (not cvs-add-default-message)))
(read-from-minibuffer "Enter description: ")
(or cvs-add-default-message "")))
- (flags (list* "-m" msg flags))
+ (flags `("-m" ,msg ,@flags))
(postproc
;; setup postprocessing for the directory entries
(when dirs
@@ -1845,7 +1845,7 @@
(setq ret t)))
ret)))
-(defun* cvs-mode-run (cmd flags fis
+(cl-defun cvs-mode-run (cmd flags fis
&key (buf (cvs-temp-buffer))
dont-change-disc cvsargs postproc)
"Generic cvs-mode-<foo> function.
@@ -1887,7 +1887,7 @@
(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.
=== modified file 'lisp/vc/smerge-mode.el'
--- a/lisp/vc/smerge-mode.el 2012-05-25 00:55:40 +0000
+++ b/lisp/vc/smerge-mode.el 2012-07-10 11:51:54 +0000
@@ -43,7 +43,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'diff-mode) ;For diff-auto-refine-mode.
(require 'newcomment)
@@ -716,7 +716,7 @@
(while (or (not (match-end i))
(< (point) (match-beginning i))
(>= (point) (match-end i)))
- (decf i))
+ (cl-decf i))
i))
(defun smerge-keep-current ()
@@ -779,7 +779,7 @@
(filename (or (match-string 1) ""))
(_ (re-search-forward smerge-end-re))
- (_ (assert (< orig-point (match-end 0))))
+ (_ (cl-assert (< orig-point (match-end 0))))
(other-end (match-beginning 0))
(end (match-end 0))
@@ -1073,12 +1073,12 @@
(forward-line 1) ;Skip hunk header.
(and (re-search-forward "^[0-9]" nil 'move) ;Skip hunk body.
(goto-char (match-beginning 0))))
- ;; (assert (or (null last1) (< (overlay-start last1) end1)))
- ;; (assert (or (null last2) (< (overlay-start last2) end2)))
+ ;; (cl-assert (or (null last1) (< (overlay-start last1) end1)))
+ ;; (cl-assert (or (null last2) (< (overlay-start last2) end2)))
(if smerge-refine-weight-hack
(progn
- ;; (assert (or (null last1) (<= (overlay-end last1) end1)))
- ;; (assert (or (null last2) (<= (overlay-end last2) end2)))
+ ;; (cl-assert (or (null last1) (<= (overlay-end last1)
end1)))
+ ;; (cl-assert (or (null last2) (<= (overlay-end last2)
end2)))
)
;; smerge-refine-forward-function when calling in chopup may
;; have stopped because it bumped into EOB whereas in
@@ -1290,8 +1290,8 @@
(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)
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r108998: Reduce use of (require 'cl).,
Stefan Monnier <=