1 ;;; cl-lib.el --- Properly prefixed CL functions and macros -*- coding: utf-8 -*-
3 ;; Copyright (C) 2012, 2013, 2014 Free Software Foundation, Inc.
5 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
6 ;; vcomment: Emacs-24.3's version is 1.0 so this has to stay below.
9 ;; This program is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation, either version 3 of the License, or
12 ;; (at your option) any later version.
14 ;; This program is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
24 ;; This is a forward compatibility package, which provides (a subset of) the
25 ;; features of the cl-lib package introduced in Emacs-24.3, for use on
28 ;; Make sure this is installed *late* in your `load-path`, i.e. after Emacs's
29 ;; built-in .../lisp/emacs-lisp directory, so that if/when you upgrade to
30 ;; Emacs-24.3, the built-in version of the file will take precedence, otherwise
31 ;; you could get into trouble (although we try to hack our way around the
32 ;; problem in case it happens).
34 ;; This code is largely copied from Emacs-24.3's cl.el, with the alias bindings
39 ;; We need to handle the situation where this package is used with an Emacs
40 ;; that comes with a real cl-lib (i.e. ≥24.3).
42 ;; First line of defense: try to make sure the built-in cl-lib comes earlier in
43 ;; load-path so we never get loaded:
44 ;;;###autoload (let ((d (file-name-directory #$)))
45 ;;;###autoload (when (member d load-path)
46 ;;;###autoload (setq load-path (append (remove d load-path) (list d)))))
48 (when (functionp 'macroexp--compiler-macro
)
49 ;; `macroexp--compiler-macro' was introduced as part of the big CL
50 ;; reorganization which moved/reimplemented some of CL into core (mostly the
51 ;; setf and compiler-macro support), so its presence indicates we're running
52 ;; in an Emacs that comes with the new cl-lib.el, where this file should
54 (message "Real cl-lib shadowed by compatibility cl-lib? (%s)" load-file-name
)
56 ;; (message "Let's try to patch things up")
57 (let ((loaddir (file-name-directory load-file-name
))
59 ;; Find the problematic directory from load-path.
60 (dolist (dir load-path
)
61 (if (equal loaddir
(expand-file-name (file-name-as-directory dir
)))
62 (setq load-path-dir dir
)))
64 ;; (message "Let's move the offending dir to the end")
65 (setq load-path
(append (remove load-path-dir load-path
)
66 (list load-path-dir
)))
67 ;; Here we could manually load cl-lib and then return immediately.
68 ;; But Emacs currently doesn't provide any way for a file to "return
69 ;; immediately", so instead we make sure the rest of the file does not
70 ;; throw away any pre-existing definition.
75 ;; Some of Emacs-24.3's cl.el definition are not just aliases, because either
76 ;; the feature was dropped from cl-lib.el or because the cl-lib version is
77 ;; not fully compatible.
78 ;; Let's just not include them here, since it is very important that if code
79 ;; works with this cl-lib.el it should also work with Emacs-24.3's cl-lib.el,
80 ;; whereas the reverse is much less important.
91 ;; lambda-list-keywords
92 float-negative-epsilon
94 least-negative-normalized-float
95 least-positive-normalized-float
100 ;; custom-print-functions
102 (let ((new (intern (format "cl-%s" var
))))
103 (unless (boundp new
) (defvaralias new var
))))
105 ;; The following cl-lib functions were already defined in the old cl.el,
106 ;; with a different meaning:
107 ;; - cl-position and cl-delete-duplicates
108 ;; the two meanings are clearly different, but we can distinguish which was
109 ;; meant by looking at the arguments.
111 ;; the old meaning hasn't been used for a long time and is a subset of the
112 ;; new, so we can simply override it.
114 ;; the old meaning is actually the same as the new except for optimizations.
118 (random* . cl-random
)
122 (truncate* . cl-truncate
)
123 (ceiling* . cl-ceiling
)
125 (rassoc* . cl-rassoc
)
127 ;; (member* . cl-member) ;Handle specially below.
128 (delete* . cl-delete
)
129 (remove* . cl-remove
)
130 (defsubst* . cl-defsubst
)
132 (function* . cl-function
)
133 (defmacro* . cl-defmacro
)
135 (mapcar* . cl-mapcar
)
194 ;; position ;Handle specially via defadvice below.
204 ;; delete-duplicates ;Handle specially via defadvice below.
214 define-compiler-macro
259 ;; adjoin ;It's already defined.
321 (let ((new (if (consp fun
) (prog1 (cdr fun
) (setq fun
(car fun
)))
322 (intern (format "cl-%s" fun
)))))
324 (unless (or (eq (symbol-function new
) fun
)
325 (eq new
(and (symbolp fun
) (fboundp fun
)
326 (symbol-function fun
))))
327 (message "%S already defined, not rebinding" new
))
328 (defalias new fun
))))
330 (unless (symbolp (symbol-function 'position
))
331 (autoload 'cl-position
"cl-seq")
332 (defadvice cl-position
(around cl-lib
(cl-item cl-seq
&rest cl-keys
) activate
)
333 (let ((argk (ad-get-args 2)))
334 (if (or (null argk
) (keywordp (car argk
)))
335 ;; This is a call to cl-lib's `cl-position'.
336 (setq ad-return-value
337 (apply #'position
(ad-get-arg 0) (ad-get-arg 1) argk
))
338 ;; Must be a call to cl's old `cl-position'.
341 (unless (symbolp (symbol-function 'delete-duplicates
))
342 (autoload 'cl-delete-duplicates
"cl-seq")
343 (defadvice cl-delete-duplicates
(around cl-lib
(cl-seq &rest cl-keys
) activate
)
344 (let ((argk (ad-get-args 1)))
345 (if (or (null argk
) (keywordp (car argk
)))
346 ;; This is a call to cl-lib's `cl-delete-duplicates'.
347 (setq ad-return-value
348 (apply #'delete-duplicates
(ad-get-arg 0) argk
))
349 ;; Must be a call to cl's old `cl-delete-duplicates'.
352 (when (or (not (fboundp 'cl-member
))
353 (eq (symbol-function 'cl-member
) #'memq
))
354 (defalias 'cl-member
#'member
*))
356 ;; `cl-labels' is not 100% compatible with `labels' when using dynamic scoping
357 ;; (mostly because it does not turn lambdas that refer to those functions into
358 ;; closures). OTOH it is compatible when using lexical scoping.
360 (unless (fboundp 'cl-labels
)
361 (defmacro cl-labels
(&rest args
)
362 (unless (and (boundp 'lexical-binding
) lexical-binding
)
363 ;; We used to signal an error rather than a message, but in many uses of
364 ;; cl-labels, the value of lexical-binding doesn't actually matter.
365 ;; More importantly, the value of `lexical-binding' here is unreliable
366 ;; (it does not necessarily reflect faithfully whether the output of this
367 ;; macro will be interpreted as lexically bound code or not).
368 (message "This `cl-labels' requires `lexical-binding' to be non-nil"))
373 ;; 2014-02-25 Stefan Monnier <monnier@iro.umontreal.ca>
375 ;; Fixes: debbugs:16671
377 ;; * cl-lib.el (cl-position, cl-delete-duplicate): Don't advise if >=24.3.
378 ;; (load-path): Try to make sure we're at the end.
380 ;; 2014-01-25 Stefan Monnier <monnier@iro.umontreal.ca>
382 ;; * cl-lib.el: Resolve conflicts with old internal definitions
384 ;; (dolist fun): Don't skip definitions silently.
385 ;; (define-setf-expander): Remove, not in cl-lib.
386 ;; (cl-position, cl-delete-duplicates): Add advice to distinguish the use
388 ;; (cl-member): Override old definition.
390 ;; 2013-05-22 Stefan Monnier <monnier@iro.umontreal.ca>
392 ;; * cl-lib.el (cl-labels): Demote error to message and improve it.
394 ;; 2012-11-30 Stefan Monnier <monnier@iro.umontreal.ca>
396 ;; * cl-lib.el: Try and patch things up in case we're hiding the real
399 ;; 2012-11-22 Stefan Monnier <monnier@iro.umontreal.ca>
401 ;; Add cl-letf and cl-labels.
403 ;; 2012-11-16 Stefan Monnier <monnier@iro.umontreal.ca>
405 ;; * packages/cl-lib: New package.
410 ;;; cl-lib.el ends here