lisp/emacs-lisp/cl.el

   1 ;;; cl.el --- Compatibility aliases for the old CL library.
   2
   3 ;; Copyright (C) 2012  Free Software Foundation, Inc.
   4
   5 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
   6 ;; Keywords: extensions
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; This is a compatibility file which provides the old names provided by CL
  26 ;; before we cleaned up its namespace usage.
  27
  28 ;;; Code:
  29
  30 (require 'cl-lib)
  31
  32 ;; (defun cl--rename ()
  33 ;;   (let ((vdefs ())
  34 ;;         (fdefs ())
  35 ;;         (case-fold-search nil)
  36 ;;         (files '("cl.el" "cl-macs.el" "cl-seq.el" "cl-extra.el")))
  37 ;;     (dolist (file files)
  38 ;;       (with-current-buffer (find-file-noselect file)
  39 ;;         (goto-char (point-min))
  40 ;;         (while (re-search-forward
  41 ;;                 "^(\\(def[^ \t\n]*\\) +'?\\(\\(\\sw\\|\\s_\\)+\\)" nil t)
  42 ;;           (let ((name (match-string-no-properties 2))
  43 ;;                 (type (match-string-no-properties 1)))
  44 ;;             (unless (string-match-p "\\`cl-" name)
  45 ;;               (cond
  46 ;;                ((member type '("defvar" "defconst"))
  47 ;;                 (unless (member name vdefs) (push name vdefs)))
  48 ;;                ((member type '("defun" "defsubst" "defalias" "defmacro"))
  49 ;;                 (unless (member name fdefs) (push name fdefs)))
  50 ;;                ((member type '("def-edebug-spec" "defsetf" "define-setf-method"
  51 ;;                                "define-compiler-macro"))
  52 ;;                 nil)
  53 ;;                (t (error "Unknown type %S" type))))))))
  54 ;;     (let ((re (concat "\\_<" (regexp-opt (append vdefs fdefs)) "\\_>"))
  55 ;;           (conflicts ()))
  56 ;;       (dolist (file files)
  57 ;;         (with-current-buffer (find-file-noselect file)
  58 ;;           (goto-char (point-min))
  59 ;;           (while (re-search-forward re nil t)
  60 ;;             (replace-match "cl-\\&"))
  61 ;;           (save-buffer))))
  62 ;;     (with-current-buffer (find-file-noselect "cl-rename.el")
  63 ;;       (dolist (def vdefs)
  64 ;;         (insert (format "(defvaralias '%s 'cl-%s)\n" def def)))
  65 ;;       (dolist (def fdefs)
  66 ;;         (insert (format "(defalias '%s 'cl-%s)\n" def def)))
  67 ;;       (save-buffer))))
  68
  69 ;; (defun cl--unrename ()
  70 ;;   ;; Taken from "Naming Conventions" node of the doc.
  71 ;;   (let* ((names '(defun* defsubst* defmacro* function* member*
  72 ;;                          assoc* rassoc* get* remove* delete*
  73 ;;                          mapcar* sort* floor* ceiling* truncate*
  74 ;;                          round* mod* rem* random*))
  75 ;;          (files '("cl.el" "cl-lib.el" "cl-macs.el" "cl-seq.el" "cl-extra.el"))
  76 ;;          (re (concat "\\_<cl-" (regexp-opt (mapcar #'symbol-name names))
  77 ;;                      "\\_>")))
  78 ;;     (dolist (file files)
  79 ;;       (with-current-buffer (find-file-noselect file)
  80 ;;         (goto-char (point-min))
  81 ;;         (while (re-search-forward re nil t)
  82 ;;           (delete-region (1- (point)) (point)))
  83 ;;         (save-buffer)))))
  84 (dolist (var '(
  85                ;; loop-result-var
  86                ;; loop-result
  87                ;; loop-initially
  88                ;; loop-finally
  89                ;; loop-bindings
  90                ;; loop-args
  91                ;; bind-inits
  92                ;; bind-block
  93                ;; lambda-list-keywords
  94                float-negative-epsilon
  95                float-epsilon
  96                least-negative-normalized-float
  97                least-positive-normalized-float
  98                least-negative-float
  99                least-positive-float
 100                most-negative-float
 101                most-positive-float
 102                ;; custom-print-functions
 103                ))
 104   (defvaralias var (intern (format "cl-%s" var))))
 105
 106 (dolist (fun '(
 107                (get* . cl-get)
 108                (random* . cl-random)
 109                (rem* . cl-rem)
 110                (mod* . cl-mod)
 111                (round* . cl-round)
 112                (truncate* . cl-truncate)
 113                (ceiling* . cl-ceiling)
 114                (floor* . cl-floor)
 115                (rassoc* . cl-rassoc)
 116                (assoc* . cl-assoc)
 117                (member* . cl-member)
 118                (delete* . cl-delete)
 119                (remove* . cl-remove)
 120                (defsubst* . cl-defsubst)
 121                (sort* . cl-sort)
 122                (function* . cl-function)
 123                (defmacro* . cl-defmacro)
 124                (defun* . cl-defun)
 125                (mapcar* . cl-mapcar)
 126
 127                remprop
 128                getf
 129                tailp
 130                list-length
 131                nreconc
 132                revappend
 133                concatenate
 134                subseq
 135                random-state-p
 136                make-random-state
 137                signum
 138                isqrt
 139                lcm
 140                gcd
 141                notevery
 142                notany
 143                every
 144                some
 145                mapcon
 146                mapcan
 147                mapl
 148                maplist
 149                map
 150                equalp
 151                coerce
 152                tree-equal
 153                nsublis
 154                sublis
 155                nsubst-if-not
 156                nsubst-if
 157                nsubst
 158                subst-if-not
 159                subst-if
 160                subsetp
 161                nset-exclusive-or
 162                set-exclusive-or
 163                nset-difference
 164                set-difference
 165                nintersection
 166                intersection
 167                nunion
 168                union
 169                rassoc-if-not
 170                rassoc-if
 171                assoc-if-not
 172                assoc-if
 173                member-if-not
 174                member-if
 175                merge
 176                stable-sort
 177                search
 178                mismatch
 179                count-if-not
 180                count-if
 181                count
 182                position-if-not
 183                position-if
 184                position
 185                find-if-not
 186                find-if
 187                find
 188                nsubstitute-if-not
 189                nsubstitute-if
 190                nsubstitute
 191                substitute-if-not
 192                substitute-if
 193                substitute
 194                delete-duplicates
 195                remove-duplicates
 196                delete-if-not
 197                delete-if
 198                remove-if-not
 199                remove-if
 200                replace
 201                fill
 202                reduce
 203                compiler-macroexpand
 204                define-compiler-macro
 205                assert
 206                check-type
 207                typep
 208                deftype
 209                defstruct
 210                define-modify-macro
 211                callf2
 212                callf
 213                letf*
 214                letf
 215                rotatef
 216                shiftf
 217                remf
 218                psetf
 219                setf
 220                get-setf-method
 221                defsetf
 222                (define-setf-method . cl-define-setf-expander)
 223                define-setf-expander
 224                declare
 225                the
 226                locally
 227                multiple-value-setq
 228                multiple-value-bind
 229                lexical-let*
 230                lexical-let
 231                symbol-macrolet
 232                macrolet
 233                labels
 234                flet
 235                progv
 236                psetq
 237                do-all-symbols
 238                do-symbols
 239                dotimes
 240                dolist
 241                do*
 242                do
 243                loop
 244                return-from
 245                return
 246                block
 247                etypecase
 248                typecase
 249                ecase
 250                case
 251                load-time-value
 252                eval-when
 253                destructuring-bind
 254                gentemp
 255                gensym
 256                pairlis
 257                acons
 258                subst
 259                adjoin
 260                copy-list
 261                ldiff
 262                list*
 263                cddddr
 264                cdddar
 265                cddadr
 266                cddaar
 267                cdaddr
 268                cdadar
 269                cdaadr
 270                cdaaar
 271                cadddr
 272                caddar
 273                cadadr
 274                cadaar
 275                caaddr
 276                caadar
 277                caaadr
 278                caaaar
 279                cdddr
 280                cddar
 281                cdadr
 282                cdaar
 283                caddr
 284                cadar
 285                caadr
 286                caaar
 287                tenth
 288                ninth
 289                eighth
 290                seventh
 291                sixth
 292                fifth
 293                fourth
 294                third
 295                endp
 296                rest
 297                second
 298                first
 299                svref
 300                copy-seq
 301                evenp
 302                oddp
 303                minusp
 304                plusp
 305                floatp-safe
 306                declaim
 307                proclaim
 308                nth-value
 309                multiple-value-call
 310                multiple-value-apply
 311                multiple-value-list
 312                values-list
 313                values
 314                pushnew
 315                push
 316                pop
 317                decf
 318                incf
 319                ))
 320   (let ((new (if (consp fun) (prog1 (cdr fun) (setq fun (car fun)))
 321                (intern (format "cl-%s" fun)))))
 322     (defalias fun new)
 323     ;; If `cl-foo' is declare inline, then make `foo' inline as well, and
 324     ;; similarly.  Same for edebug specifications, indent rules and
 325     ;; doc-string position.
 326     ;; FIXME: For most of them, we should instead follow aliases
 327     ;; where applicable.
 328     (dolist (prop '(byte-optimizer doc-string-elt edebug-form-spec
 329                     lisp-indent-function))
 330       (if (get new prop)
 331         (put fun prop (get new prop))))))
 332
 333 (provide 'cl)
 334 ;;; cl.el ends here