Switch from cl to cl-lib

This commit is contained in:
Steve Purcell 2013-04-01 21:16:46 +01:00 committed by Donald Curtis
parent e1700e86cb
commit aca476a4f8

View file

@ -8,6 +8,7 @@
;; Created: 2011-09-30 ;; Created: 2011-09-30
;; Version: 0.1 ;; Version: 0.1
;; Keywords: tools ;; Keywords: tools
;; Package-Requires: ((cl-lib "0.2"))
;; This file is not (yet) part of GNU Emacs. ;; This file is not (yet) part of GNU Emacs.
;; However, it is distributed under the same license. ;; However, it is distributed under the same license.
@ -40,7 +41,7 @@
;; Since this library is not meant to be loaded by users ;; Since this library is not meant to be loaded by users
;; at runtime, use of cl functions should not be a problem. ;; at runtime, use of cl functions should not be a problem.
(require 'cl) (require 'cl-lib)
(require 'package) (require 'package)
(require 'lisp-mnt) (require 'lisp-mnt)
@ -174,8 +175,8 @@ seconds; the server cuts off after 10 requests in 20 seconds.")
(defmacro pb/with-wiki-rate-limit (&rest body) (defmacro pb/with-wiki-rate-limit (&rest body)
"Rate-limit BODY code passed to this macro to match EmacsWiki's rate limiting." "Rate-limit BODY code passed to this macro to match EmacsWiki's rate limiting."
(let ((now (gensym)) (let ((now (cl-gensym))
(elapsed (gensym))) (elapsed (cl-gensym)))
`(let* ((,now (float-time)) `(let* ((,now (float-time))
(,elapsed (- ,now pb/last-wiki-fetch-time))) (,elapsed (- ,now pb/last-wiki-fetch-time)))
(when (< ,elapsed pb/wiki-min-request-interval) (when (< ,elapsed pb/wiki-min-request-interval)
@ -537,7 +538,7 @@ The file is written to `package-build-working-dir'."
;; commented properly. ;; commented properly.
(pb/update-or-insert-version "0") (pb/update-or-insert-version "0")
(pb/ensure-ends-here-line file-path) (pb/ensure-ends-here-line file-path)
(flet ((package-strip-rcs-id (str) "0")) (cl-flet ((package-strip-rcs-id (str) "0"))
(package-buffer-info)))))) (package-buffer-info))))))
(defun pb/get-pkg-file-info (file-path) (defun pb/get-pkg-file-info (file-path)
@ -559,7 +560,7 @@ The file is written to `package-build-working-dir'."
(defun pb/merge-package-info (pkg-info name version config) (defun pb/merge-package-info (pkg-info name version config)
"Return a version of PKG-INFO updated with NAME, VERSION and info from CONFIG. "Return a version of PKG-INFO updated with NAME, VERSION and info from CONFIG.
If PKG-INFO is nil, an empty one is created." If PKG-INFO is nil, an empty one is created."
(let* ((merged (or (copy-seq pkg-info) (let* ((merged (or (copy-sequence pkg-info)
(vector name nil "No description available." version)))) (vector name nil "No description available." version))))
(aset merged 0 name) (aset merged 0 name)
(aset merged 2 (format "%s [source: %s]" (aset merged 2 (format "%s [source: %s]"
@ -625,12 +626,12 @@ of the same-named package which is to be kept."
(defun pb/read-recipes () (defun pb/read-recipes ()
"Return a list of data structures for all recipes in `package-build-recipes-dir'." "Return a list of data structures for all recipes in `package-build-recipes-dir'."
(loop for file-name in (directory-files package-build-recipes-dir t "^[^.]") (cl-loop for file-name in (directory-files package-build-recipes-dir t "^[^.]")
collect (pb/read-recipe file-name))) collect (pb/read-recipe file-name)))
(defun pb/read-recipes-ignore-errors () (defun pb/read-recipes-ignore-errors ()
"Return a list of data structures for all recipes in `package-build-recipes-dir'." "Return a list of data structures for all recipes in `package-build-recipes-dir'."
(loop for file-name in (directory-files package-build-recipes-dir t "^[^.]") (cl-loop for file-name in (directory-files package-build-recipes-dir t "^[^.]")
for pkg-info = (condition-case err (pb/read-recipe file-name) for pkg-info = (condition-case err (pb/read-recipe file-name)
(error (message (error-message-string err)) (error (message (error-message-string err))
nil)) nil))
@ -646,7 +647,7 @@ file path and DEST is the relative path to which it should be copied."
(prefix (if subdir (prefix (if subdir
(format "%s/" subdir) (format "%s/" subdir)
""))) "")))
(mapcan (cl-mapcan
(lambda (entry) (lambda (entry)
(if (consp entry) (if (consp entry)
(pb/expand-file-specs dir (pb/expand-file-specs dir
@ -671,7 +672,7 @@ file path and DEST is the relative path to which it should be copied."
(defun pb/copy-package-files (files source-dir target-dir) (defun pb/copy-package-files (files source-dir target-dir)
"Copy FILES from SOURCE-DIR to TARGET-DIR. "Copy FILES from SOURCE-DIR to TARGET-DIR.
FILES is a list of (SOURCE . DEST) relative filepath pairs." FILES is a list of (SOURCE . DEST) relative filepath pairs."
(loop for (source-file . dest-file) in files (cl-loop for (source-file . dest-file) in files
do (pb/copy-file do (pb/copy-file
(expand-file-name source-file source-dir) (expand-file-name source-file source-dir)
(expand-file-name dest-file target-dir)))) (expand-file-name dest-file target-dir))))
@ -892,7 +893,7 @@ FILES is a list of (SOURCE . DEST) relative filepath pairs."
(defun package-build-all () (defun package-build-all ()
"Build all packages in the `package-build-recipe-alist'." "Build all packages in the `package-build-recipe-alist'."
(interactive) (interactive)
(let ((failed (loop for pkg in (mapcar 'car (package-build-recipe-alist)) (let ((failed (cl-loop for pkg in (mapcar 'car (package-build-recipe-alist))
when (not (package-build-archive-ignore-errors pkg)) when (not (package-build-archive-ignore-errors pkg))
collect pkg))) collect pkg)))
(if (not failed) (if (not failed)
@ -906,7 +907,7 @@ FILES is a list of (SOURCE . DEST) relative filepath pairs."
"Remove previously-built packages that no longer have recipes." "Remove previously-built packages that no longer have recipes."
(interactive) (interactive)
(let* ((known-package-names (mapcar 'car (package-build-recipe-alist))) (let* ((known-package-names (mapcar 'car (package-build-recipe-alist)))
(stale-archives (loop for built in (package-build-archive-alist) (stale-archives (cl-loop for built in (package-build-archive-alist)
when (not (memq (car built) known-package-names)) when (not (memq (car built) known-package-names))
collect built))) collect built)))
(mapc 'pb/remove-archive stale-archives) (mapc 'pb/remove-archive stale-archives)
@ -962,7 +963,6 @@ FILES is a list of (SOURCE . DEST) relative filepath pairs."
;; Local Variables: ;; Local Variables:
;; coding: utf-8 ;; coding: utf-8
;; byte-compile-warnings: (not cl-functions)
;; eval: (checkdoc-minor-mode 1) ;; eval: (checkdoc-minor-mode 1)
;; End: ;; End: