;;; cl-lib.el --- Properly prefixed CL functions and macros -*- coding: utf-8 -*- ;; Copyright (C) 2012, 2013, 2014 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; vcomment: Emacs-24.3's version is 1.0 so this has to stay below. ;; 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 ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; This is a forward compatibility package, which provides (a subset of) the ;; features of the cl-lib package introduced in Emacs-24.3, for use on ;; previous emacsen. ;; 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 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 ;; the feature was dropped from cl-lib.el or because the cl-lib version is ;; not fully compatible. ;; Let's just not include them here, since it is very important that if code ;; works with this cl-lib.el it should also work with Emacs-24.3's cl-lib.el, ;; whereas the reverse is much less important. (dolist (var '( ;; loop-result-var ;; loop-result ;; loop-initially ;; loop-finally ;; loop-bindings ;; loop-args ;; bind-inits ;; bind-block ;; lambda-list-keywords float-negative-epsilon float-epsilon least-negative-normalized-float least-positive-normalized-float least-negative-float least-positive-float most-negative-float most-positive-float ;; custom-print-functions )) (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) (rem* . cl-rem) (mod* . cl-mod) (round* . cl-round) (truncate* . cl-truncate) (ceiling* . cl-ceiling) (floor* . cl-floor) (rassoc* . cl-rassoc) (assoc* . cl-assoc) ;; (member* . cl-member) ;Handle specially below. (delete* . cl-delete) (remove* . cl-remove) (defsubst* . cl-defsubst) (sort* . cl-sort) (function* . cl-function) (defmacro* . cl-defmacro) (defun* . cl-defun) (mapcar* . cl-mapcar) remprop getf tailp list-length nreconc revappend concatenate subseq random-state-p make-random-state signum isqrt lcm gcd notevery notany every some mapcon mapcan mapl maplist map equalp coerce tree-equal nsublis sublis nsubst-if-not nsubst-if nsubst subst-if-not subst-if subsetp nset-exclusive-or set-exclusive-or nset-difference set-difference nintersection intersection nunion union rassoc-if-not rassoc-if assoc-if-not assoc-if member-if-not member-if merge stable-sort search mismatch count-if-not count-if count position-if-not position-if ;; position ;Handle specially via defadvice below. find-if-not find-if find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not substitute-if substitute ;; delete-duplicates ;Handle specially via defadvice below. remove-duplicates delete-if-not delete-if remove-if-not remove-if replace fill reduce compiler-macroexpand define-compiler-macro assert check-type typep deftype defstruct callf2 callf letf* letf rotatef shiftf remf psetf declare the locally multiple-value-setq multiple-value-bind symbol-macrolet macrolet progv psetq do-all-symbols do-symbols dotimes dolist do* do loop return-from return block etypecase typecase ecase case load-time-value eval-when destructuring-bind gentemp gensym pairlis acons subst ;; adjoin ;It's already defined. copy-list ldiff list* cddddr cdddar cddadr cddaar cdaddr cdadar cdaadr cdaaar cadddr caddar cadadr cadaar caaddr caadar caaadr caaaar cdddr cddar cdadr cdaar caddr cadar caadr caaar tenth ninth eighth seventh sixth fifth fourth third endp rest second first svref copy-seq evenp oddp minusp plusp floatp-safe declaim proclaim nth-value multiple-value-call multiple-value-apply multiple-value-list values-list values pushnew decf incf dolist dotimes )) (let ((new (if (consp fun) (prog1 (cdr fun) (setq fun (car fun))) (intern (format "cl-%s" 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. (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))) ;;;; ChangeLog: ;; 2014-02-25 Stefan Monnier ;; ;; Fixes: debbugs:16671 ;; ;; * cl-lib.el (cl-position, cl-delete-duplicate): Don't advise if >=24.3. ;; (load-path): Try to make sure we're at the end. ;; ;; 2014-01-25 Stefan Monnier ;; ;; * cl-lib.el: Resolve conflicts with old internal definitions ;; (bug#16353). ;; (dolist fun): Don't skip definitions silently. ;; (define-setf-expander): Remove, not in cl-lib. ;; (cl-position, cl-delete-duplicates): Add advice to distinguish the use ;; case. ;; (cl-member): Override old definition. ;; ;; 2013-05-22 Stefan Monnier ;; ;; * cl-lib.el (cl-labels): Demote error to message and improve it. ;; ;; 2012-11-30 Stefan Monnier ;; ;; * cl-lib.el: Try and patch things up in case we're hiding the real ;; cl-lib. ;; ;; 2012-11-22 Stefan Monnier ;; ;; Add cl-letf and cl-labels. ;; ;; 2012-11-16 Stefan Monnier ;; ;; * packages/cl-lib: New package. ;; (provide 'cl-lib) ;;; cl-lib.el ends here