auto-install/cl-lib.el

   1 ;;; cl-lib.el --- Properly prefixed CL functions and macros  -*- coding: utf-8 -*-
   2
   3 ;; Copyright (C) 2012, 2013, 2014  Free Software Foundation, Inc.
   4
   5 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
   6 ;; vcomment: Emacs-24.3's version is 1.0 so this has to stay below.
   7 ;; Version: 0.4
   8
   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.
  13
  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.
  18
  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/>.
  21
  22 ;;; Commentary:
  23
  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
  26 ;; previous emacsen.
  27
  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).
  33
  34 ;; This code is largely copied from Emacs-24.3's cl.el, with the alias bindings
  35 ;; simply reversed.
  36
  37 ;;; Code:
  38
  39 (when (functionp 'macroexp--compiler-macro)
  40   ;; `macroexp--compiler-macro' was introduced as part of the big CL
  41   ;; reorganization which moved/reimplemented some of CL into core (mostly the
  42   ;; setf and compiler-macro support), so its presence indicates we're running
  43   ;; in an Emacs that comes with the new cl-lib.el, where this file should
  44   ;; never be loaded!
  45   (message "Real cl-lib shadowed by compatibility cl-lib? (%s)" load-file-name)
  46   (when load-file-name
  47     ;; (message "Let's try to patch things up")
  48     (let ((loaddir (file-name-directory load-file-name))
  49           load-path-dir)
  50       ;; Find the problematic directory from load-path.
  51       (dolist (dir load-path)
  52         (if (equal loaddir (expand-file-name (file-name-as-directory dir)))
  53             (setq load-path-dir dir)))
  54       (when load-path-dir
  55         ;; (message "Let's move the offending dir to the end")
  56         (setq load-path (append (remove load-path-dir load-path)
  57                                 (list load-path-dir)))
  58         ;; Here we could manually load cl-lib and then return immediately.
  59         ;; But Emacs currently doesn't provide any way for a file to "return
  60         ;; immediately", so instead we make sure the rest of the file does not
  61         ;; throw away any pre-existing definition.
  62         ))))
  63
  64 (require 'cl)
  65
  66 ;; Some of Emacs-24.3's cl.el definition are not just aliases, because either
  67 ;; the feature was dropped from cl-lib.el or because the cl-lib version is
  68 ;; not fully compatible.
  69 ;; Let's just not include them here, since it is very important that if code
  70 ;; works with this cl-lib.el it should also work with Emacs-24.3's cl-lib.el,
  71 ;; whereas the reverse is much less important.
  72
  73 (dolist (var '(
  74                ;; loop-result-var
  75                ;; loop-result
  76                ;; loop-initially
  77                ;; loop-finally
  78                ;; loop-bindings
  79                ;; loop-args
  80                ;; bind-inits
  81                ;; bind-block
  82                ;; lambda-list-keywords
  83                float-negative-epsilon
  84                float-epsilon
  85                least-negative-normalized-float
  86                least-positive-normalized-float
  87                least-negative-float
  88                least-positive-float
  89                most-negative-float
  90                most-positive-float
  91                ;; custom-print-functions
  92                ))
  93   (let ((new (intern (format "cl-%s" var))))
  94     (unless (boundp new) (defvaralias new var))))
  95
  96 ;; The following cl-lib functions were already defined in the old cl.el,
  97 ;; with a different meaning:
  98 ;; - cl-position and cl-delete-duplicates
  99 ;;   the two meanings are clearly different, but we can distinguish which was
 100 ;;   meant by looking at the arguments.
 101 ;; - cl-member
 102 ;;   the old meaning hasn't been used for a long time and is a subset of the
 103 ;;   new, so we can simply override it.
 104 ;; - cl-adjoin
 105 ;;   the old meaning is actually the same as the new except for optimizations.
 106
 107 (dolist (fun '(
 108                (get* . cl-get)
 109                (random* . cl-random)
 110                (rem* . cl-rem)
 111                (mod* . cl-mod)
 112                (round* . cl-round)
 113                (truncate* . cl-truncate)
 114                (ceiling* . cl-ceiling)
 115                (floor* . cl-floor)
 116                (rassoc* . cl-rassoc)
 117                (assoc* . cl-assoc)
 118                ;; (member* . cl-member) ;Handle specially below.
 119                (delete* . cl-delete)
 120                (remove* . cl-remove)
 121                (defsubst* . cl-defsubst)
 122                (sort* . cl-sort)
 123                (function* . cl-function)
 124                (defmacro* . cl-defmacro)
 125                (defun* . cl-defun)
 126                (mapcar* . cl-mapcar)
 127
 128                remprop
 129                getf
 130                tailp
 131                list-length
 132                nreconc
 133                revappend
 134                concatenate
 135                subseq
 136                random-state-p
 137                make-random-state
 138                signum
 139                isqrt
 140                lcm
 141                gcd
 142                notevery
 143                notany
 144                every
 145                some
 146                mapcon
 147                mapcan
 148                mapl
 149                maplist
 150                map
 151                equalp
 152                coerce
 153                tree-equal
 154                nsublis
 155                sublis
 156                nsubst-if-not
 157                nsubst-if
 158                nsubst
 159                subst-if-not
 160                subst-if
 161                subsetp
 162                nset-exclusive-or
 163                set-exclusive-or
 164                nset-difference
 165                set-difference
 166                nintersection
 167                intersection
 168                nunion
 169                union
 170                rassoc-if-not
 171                rassoc-if
 172                assoc-if-not
 173                assoc-if
 174                member-if-not
 175                member-if
 176                merge
 177                stable-sort
 178                search
 179                mismatch
 180                count-if-not
 181                count-if
 182                count
 183                position-if-not
 184                position-if
 185                ;; position ;Handle specially via defadvice below.
 186                find-if-not
 187                find-if
 188                find
 189                nsubstitute-if-not
 190                nsubstitute-if
 191                nsubstitute
 192                substitute-if-not
 193                substitute-if
 194                substitute
 195                ;; delete-duplicates ;Handle specially via defadvice below.
 196                remove-duplicates
 197                delete-if-not
 198                delete-if
 199                remove-if-not
 200                remove-if
 201                replace
 202                fill
 203                reduce
 204                compiler-macroexpand
 205                define-compiler-macro
 206                assert
 207                check-type
 208                typep
 209                deftype
 210                defstruct
 211                callf2
 212                callf
 213                letf*
 214                letf
 215                rotatef
 216                shiftf
 217                remf
 218                psetf
 219                declare
 220                the
 221                locally
 222                multiple-value-setq
 223                multiple-value-bind
 224                symbol-macrolet
 225                macrolet
 226                progv
 227                psetq
 228                do-all-symbols
 229                do-symbols
 230                dotimes
 231                dolist
 232                do*
 233                do
 234                loop
 235                return-from
 236                return
 237                block
 238                etypecase
 239                typecase
 240                ecase
 241                case
 242                load-time-value
 243                eval-when
 244                destructuring-bind
 245                gentemp
 246                gensym
 247                pairlis
 248                acons
 249                subst
 250                ;; adjoin ;It's already defined.
 251                copy-list
 252                ldiff
 253                list*
 254                cddddr
 255                cdddar
 256                cddadr
 257                cddaar
 258                cdaddr
 259                cdadar
 260                cdaadr
 261                cdaaar
 262                cadddr
 263                caddar
 264                cadadr
 265                cadaar
 266                caaddr
 267                caadar
 268                caaadr
 269                caaaar
 270                cdddr
 271                cddar
 272                cdadr
 273                cdaar
 274                caddr
 275                cadar
 276                caadr
 277                caaar
 278                tenth
 279                ninth
 280                eighth
 281                seventh
 282                sixth
 283                fifth
 284                fourth
 285                third
 286                endp
 287                rest
 288                second
 289                first
 290                svref
 291                copy-seq
 292                evenp
 293                oddp
 294                minusp
 295                plusp
 296                floatp-safe
 297                declaim
 298                proclaim
 299                nth-value
 300                multiple-value-call
 301                multiple-value-apply
 302                multiple-value-list
 303                values-list
 304                values
 305                pushnew
 306                decf
 307                incf
 308
 309                dolist
 310                dotimes
 311                ))
 312   (let ((new (if (consp fun) (prog1 (cdr fun) (setq fun (car fun)))
 313                (intern (format "cl-%s" fun)))))
 314     (if (fboundp new)
 315         (unless (or (eq (symbol-function new) fun)
 316                     (eq new (and (symbolp fun) (fboundp fun)
 317                                  (symbol-function fun))))
 318           (message "%S already defined, not rebinding" new))
 319       (defalias new fun))))
 320
 321 (autoload 'cl-position "cl-seq")
 322 (defadvice cl-position (around cl-lib (cl-item cl-seq &rest cl-keys) activate)
 323   (let ((argk (ad-get-args 2)))
 324     (if (or (null argk) (keywordp (car argk)))
 325         ;; This is a call to cl-lib's `cl-position'.
 326         (setq ad-return-value
 327               (apply #'position (ad-get-arg 0) (ad-get-arg 1) argk))
 328       ;; Must be a call to cl's old `cl-position'.
 329       ad-do-it)))
 330
 331 (autoload 'cl-delete-duplicates "cl-seq")
 332 (defadvice cl-delete-duplicates (around cl-lib (cl-seq &rest cl-keys) activate)
 333   (let ((argk (ad-get-args 1)))
 334     (if (or (null argk) (keywordp (car argk)))
 335         ;; This is a call to cl-lib's `cl-delete-duplicates'.
 336         (setq ad-return-value
 337               (apply #'delete-duplicates (ad-get-arg 0) argk))
 338       ;; Must be a call to cl's old `cl-delete-duplicates'.
 339       ad-do-it)))
 340
 341 (when (or (not (fboundp 'cl-member))
 342           (eq (symbol-function 'cl-member) #'memq))
 343   (defalias 'cl-member #'member*))
 344
 345 ;; `cl-labels' is not 100% compatible with `labels' when using dynamic scoping
 346 ;; (mostly because it does not turn lambdas that refer to those functions into
 347 ;; closures).  OTOH it is compatible when using lexical scoping.
 348
 349 (unless (fboundp 'cl-labels)
 350   (defmacro cl-labels (&rest args)
 351     (unless (and (boundp 'lexical-binding) lexical-binding)
 352       ;; We used to signal an error rather than a message, but in many uses of
 353       ;; cl-labels, the value of lexical-binding doesn't actually matter.
 354       ;; More importantly, the value of `lexical-binding' here is unreliable
 355       ;; (it does not necessarily reflect faithfully whether the output of this
 356       ;; macro will be interpreted as lexically bound code or not).
 357       (message "This `cl-labels' requires `lexical-binding' to be non-nil"))
 358     `(labels ,@args)))
 359
 360 ;;;; ChangeLog:
 361
 362 ;; 2014-01-25  Stefan Monnier  <monnier@iro.umontreal.ca>
 363 ;;
 364 ;;      * cl-lib.el: Resolve conflicts with old internal definitions
 365 ;;      (bug#16353).
 366 ;;      (dolist fun): Don't skip definitions silently.
 367 ;;      (define-setf-expander): Remove, not in cl-lib.
 368 ;;      (cl-position, cl-delete-duplicates): Add advice to distinguish the use
 369 ;;      case.
 370 ;;      (cl-member): Override old definition.
 371 ;;
 372 ;; 2013-05-22  Stefan Monnier  <monnier@iro.umontreal.ca>
 373 ;;
 374 ;;      * cl-lib.el (cl-labels): Demote error to message and improve it.
 375 ;;
 376 ;; 2012-11-30  Stefan Monnier  <monnier@iro.umontreal.ca>
 377 ;;
 378 ;;      * cl-lib.el: Try and patch things up in case we're hiding the real
 379 ;;      cl-lib.
 380 ;;
 381 ;; 2012-11-22  Stefan Monnier  <monnier@iro.umontreal.ca>
 382 ;;
 383 ;;      Add cl-letf and cl-labels.
 384 ;;
 385 ;; 2012-11-16  Stefan Monnier  <monnier@iro.umontreal.ca>
 386 ;;
 387 ;;      * packages/cl-lib: New package.
 388 ;;
 389
 390
 391 (provide 'cl-lib)
 392 ;;; cl-lib.el ends here