;;; cl-lib.el --- Properly prefixed CL functions and macros -*- coding: utf-8 -*-
-;; Copyright (C) 2012 Free Software Foundation, Inc.
+;; Copyright (C) 2012, 2013, 2014 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; vcomment: Emacs-24.3's version is 1.0 so this has to stay below.
-;; Version: 0.2
+;; Version: 0.5
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; Make sure this is installed *late* in your `load-path`, i.e. after Emacs's
;; built-in .../lisp/emacs-lisp directory, so that if/when you upgrade to
;; Emacs-24.3, the built-in version of the file will take precedence, otherwise
-;; you'll quickly get recursive-load errors.
+;; you could get into trouble (although we try to hack our way around the
+;; problem in case it happens).
;; This code is largely copied from Emacs-24.3's cl.el, with the alias bindings
;; simply reversed.
;;; Code:
+;; We need to handle the situation where this package is used with an Emacs
+;; that comes with a real cl-lib (i.e. ≥24.3).
+
+;; First line of defense: try to make sure the built-in cl-lib comes earlier in
+;; load-path so we never get loaded:
+;;;###autoload (let ((d (file-name-directory #$)))
+;;;###autoload (when (member d load-path)
+;;;###autoload (setq load-path (append (remove d load-path) (list d)))))
+
+(when (functionp 'macroexp--compiler-macro)
+ ;; `macroexp--compiler-macro' was introduced as part of the big CL
+ ;; reorganization which moved/reimplemented some of CL into core (mostly the
+ ;; setf and compiler-macro support), so its presence indicates we're running
+ ;; in an Emacs that comes with the new cl-lib.el, where this file should
+ ;; never be loaded!
+ (message "Real cl-lib shadowed by compatibility cl-lib? (%s)" load-file-name)
+ (when load-file-name
+ ;; (message "Let's try to patch things up")
+ (let ((loaddir (file-name-directory load-file-name))
+ load-path-dir)
+ ;; Find the problematic directory from load-path.
+ (dolist (dir load-path)
+ (if (equal loaddir (expand-file-name (file-name-as-directory dir)))
+ (setq load-path-dir dir)))
+ (when load-path-dir
+ ;; (message "Let's move the offending dir to the end")
+ (setq load-path (append (remove load-path-dir load-path)
+ (list load-path-dir)))
+ ;; Here we could manually load cl-lib and then return immediately.
+ ;; But Emacs currently doesn't provide any way for a file to "return
+ ;; immediately", so instead we make sure the rest of the file does not
+ ;; throw away any pre-existing definition.
+ ))))
+
(require 'cl)
;; Some of Emacs-24.3's cl.el definition are not just aliases, because either
most-positive-float
;; custom-print-functions
))
- (defvaralias (intern (format "cl-%s" var)) var))
+ (let ((new (intern (format "cl-%s" var))))
+ (unless (boundp new) (defvaralias new var))))
+
+;; The following cl-lib functions were already defined in the old cl.el,
+;; with a different meaning:
+;; - cl-position and cl-delete-duplicates
+;; the two meanings are clearly different, but we can distinguish which was
+;; meant by looking at the arguments.
+;; - cl-member
+;; the old meaning hasn't been used for a long time and is a subset of the
+;; new, so we can simply override it.
+;; - cl-adjoin
+;; the old meaning is actually the same as the new except for optimizations.
(dolist (fun '(
(get* . cl-get)
(floor* . cl-floor)
(rassoc* . cl-rassoc)
(assoc* . cl-assoc)
- (member* . cl-member)
+ ;; (member* . cl-member) ;Handle specially below.
(delete* . cl-delete)
(remove* . cl-remove)
(defsubst* . cl-defsubst)
count
position-if-not
position-if
- position
+ ;; position ;Handle specially via defadvice below.
find-if-not
find-if
find
substitute-if-not
substitute-if
substitute
- delete-duplicates
+ ;; delete-duplicates ;Handle specially via defadvice below.
remove-duplicates
delete-if-not
delete-if
shiftf
remf
psetf
- (define-setf-method . define-setf-expander)
declare
the
locally
pairlis
acons
subst
- adjoin
+ ;; adjoin ;It's already defined.
copy-list
ldiff
list*
))
(let ((new (if (consp fun) (prog1 (cdr fun) (setq fun (car fun)))
(intern (format "cl-%s" fun)))))
- (defalias new fun)))
+ (if (fboundp new)
+ (unless (or (eq (symbol-function new) fun)
+ (eq new (and (symbolp fun) (fboundp fun)
+ (symbol-function fun))))
+ (message "%S already defined, not rebinding" new))
+ (defalias new fun))))
+
+(unless (symbolp (symbol-function 'position))
+ (autoload 'cl-position "cl-seq")
+ (defadvice cl-position (around cl-lib (cl-item cl-seq &rest cl-keys) activate)
+ (let ((argk (ad-get-args 2)))
+ (if (or (null argk) (keywordp (car argk)))
+ ;; This is a call to cl-lib's `cl-position'.
+ (setq ad-return-value
+ (apply #'position (ad-get-arg 0) (ad-get-arg 1) argk))
+ ;; Must be a call to cl's old `cl-position'.
+ ad-do-it))))
+
+(unless (symbolp (symbol-function 'delete-duplicates))
+ (autoload 'cl-delete-duplicates "cl-seq")
+ (defadvice cl-delete-duplicates (around cl-lib (cl-seq &rest cl-keys) activate)
+ (let ((argk (ad-get-args 1)))
+ (if (or (null argk) (keywordp (car argk)))
+ ;; This is a call to cl-lib's `cl-delete-duplicates'.
+ (setq ad-return-value
+ (apply #'delete-duplicates (ad-get-arg 0) argk))
+ ;; Must be a call to cl's old `cl-delete-duplicates'.
+ ad-do-it))))
+
+(when (or (not (fboundp 'cl-member))
+ (eq (symbol-function 'cl-member) #'memq))
+ (defalias 'cl-member #'member*))
;; `cl-labels' is not 100% compatible with `labels' when using dynamic scoping
;; (mostly because it does not turn lambdas that refer to those functions into
;; closures). OTOH it is compatible when using lexical scoping.
-(defmacro cl-labels (&rest args)
- (if (and (boundp 'lexical-binding) lexical-binding)
- `(labels ,@args)
- (error "`cl-labels' with dynamic scoping is not implemented")))
+(unless (fboundp 'cl-labels)
+ (defmacro cl-labels (&rest args)
+ (unless (and (boundp 'lexical-binding) lexical-binding)
+ ;; We used to signal an error rather than a message, but in many uses of
+ ;; cl-labels, the value of lexical-binding doesn't actually matter.
+ ;; More importantly, the value of `lexical-binding' here is unreliable
+ ;; (it does not necessarily reflect faithfully whether the output of this
+ ;; macro will be interpreted as lexically bound code or not).
+ (message "This `cl-labels' requires `lexical-binding' to be non-nil"))
+ `(labels ,@args)))
(provide 'cl-lib)
;;; cl-lib.el ends here