;;; cl-lib.el --- Properly prefixed CL functions and macros -*- coding: utf-8 -*-
-;; Copyright (C) 2012, 2013 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.3
+;; Version: 0.4
;; 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
(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)
(random* . cl-random)
(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)))))
- (unless (fboundp new) (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))))
+
+(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)))
+
+(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