code.delx.au - gnu-emacs-elpa/blob - packages/cl-lib/cl-lib.el

   1 ;;; cl-lib.el --- Properly prefixed CL functions and macros  -*- coding: utf-8 -*-
   2
   3 ;; Copyright (C) 2012, 2013  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.3
   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 (dolist (fun '(
  97                (get* . cl-get)
  98                (random* . cl-random)
  99                (rem* . cl-rem)
 100                (mod* . cl-mod)
 101                (round* . cl-round)
 102                (truncate* . cl-truncate)
 103                (ceiling* . cl-ceiling)
 104                (floor* . cl-floor)
 105                (rassoc* . cl-rassoc)
 106                (assoc* . cl-assoc)
 107                (member* . cl-member)
 108                (delete* . cl-delete)
 109                (remove* . cl-remove)
 110                (defsubst* . cl-defsubst)
 111                (sort* . cl-sort)
 112                (function* . cl-function)
 113                (defmacro* . cl-defmacro)
 114                (defun* . cl-defun)
 115                (mapcar* . cl-mapcar)
 116
 117                remprop
 118                getf
 119                tailp
 120                list-length
 121                nreconc
 122                revappend
 123                concatenate
 124                subseq
 125                random-state-p
 126                make-random-state
 127                signum
 128                isqrt
 129                lcm
 130                gcd
 131                notevery
 132                notany
 133                every
 134                some
 135                mapcon
 136                mapcan
 137                mapl
 138                maplist
 139                map
 140                equalp
 141                coerce
 142                tree-equal
 143                nsublis
 144                sublis
 145                nsubst-if-not
 146                nsubst-if
 147                nsubst
 148                subst-if-not
 149                subst-if
 150                subsetp
 151                nset-exclusive-or
 152                set-exclusive-or
 153                nset-difference
 154                set-difference
 155                nintersection
 156                intersection
 157                nunion
 158                union
 159                rassoc-if-not
 160                rassoc-if
 161                assoc-if-not
 162                assoc-if
 163                member-if-not
 164                member-if
 165                merge
 166                stable-sort
 167                search
 168                mismatch
 169                count-if-not
 170                count-if
 171                count
 172                position-if-not
 173                position-if
 174                position
 175                find-if-not
 176                find-if
 177                find
 178                nsubstitute-if-not
 179                nsubstitute-if
 180                nsubstitute
 181                substitute-if-not
 182                substitute-if
 183                substitute
 184                delete-duplicates
 185                remove-duplicates
 186                delete-if-not
 187                delete-if
 188                remove-if-not
 189                remove-if
 190                replace
 191                fill
 192                reduce
 193                compiler-macroexpand
 194                define-compiler-macro
 195                assert
 196                check-type
 197                typep
 198                deftype
 199                defstruct
 200                callf2
 201                callf
 202                letf*
 203                letf
 204                rotatef
 205                shiftf
 206                remf
 207                psetf
 208                (define-setf-method . define-setf-expander)
 209                declare
 210                the
 211                locally
 212                multiple-value-setq
 213                multiple-value-bind
 214                symbol-macrolet
 215                macrolet
 216                progv
 217                psetq
 218                do-all-symbols
 219                do-symbols
 220                dotimes
 221                dolist
 222                do*
 223                do
 224                loop
 225                return-from
 226                return
 227                block
 228                etypecase
 229                typecase
 230                ecase
 231                case
 232                load-time-value
 233                eval-when
 234                destructuring-bind
 235                gentemp
 236                gensym
 237                pairlis
 238                acons
 239                subst
 240                adjoin
 241                copy-list
 242                ldiff
 243                list*
 244                cddddr
 245                cdddar
 246                cddadr
 247                cddaar
 248                cdaddr
 249                cdadar
 250                cdaadr
 251                cdaaar
 252                cadddr
 253                caddar
 254                cadadr
 255                cadaar
 256                caaddr
 257                caadar
 258                caaadr
 259                caaaar
 260                cdddr
 261                cddar
 262                cdadr
 263                cdaar
 264                caddr
 265                cadar
 266                caadr
 267                caaar
 268                tenth
 269                ninth
 270                eighth
 271                seventh
 272                sixth
 273                fifth
 274                fourth
 275                third
 276                endp
 277                rest
 278                second
 279                first
 280                svref
 281                copy-seq
 282                evenp
 283                oddp
 284                minusp
 285                plusp
 286                floatp-safe
 287                declaim
 288                proclaim
 289                nth-value
 290                multiple-value-call
 291                multiple-value-apply
 292                multiple-value-list
 293                values-list
 294                values
 295                pushnew
 296                decf
 297                incf
 298
 299                dolist
 300                dotimes
 301                ))
 302   (let ((new (if (consp fun) (prog1 (cdr fun) (setq fun (car fun)))
 303                (intern (format "cl-%s" fun)))))
 304     (unless (fboundp new) (defalias new fun))))
 305
 306 ;; `cl-labels' is not 100% compatible with `labels' when using dynamic scoping
 307 ;; (mostly because it does not turn lambdas that refer to those functions into
 308 ;; closures).  OTOH it is compatible when using lexical scoping.
 309
 310 (unless (fboundp 'cl-labels)
 311   (defmacro cl-labels (&rest args)
 312     (unless (and (boundp 'lexical-binding) lexical-binding)
 313       ;; We used to signal an error rather than a message, but in many uses of
 314       ;; cl-labels, the value of lexical-binding doesn't actually matter.
 315       ;; More importantly, the value of `lexical-binding' here is unreliable
 316       ;; (it does not necessarily reflect faithfully whether the output of this
 317       ;; macro will be interpreted as lexically bound code or not).
 318       (message "This `cl-labels' requires `lexical-binding' to be non-nil"))
 319     `(labels ,@args)))
 320
 321 (provide 'cl-lib)
 322 ;;; cl-lib.el ends here