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"))
372 ;;; cl-lib.el ends here