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,17 +626,17 @@ 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))
when pkg-info when pkg-info
collect pkg-info)) collect pkg-info))
(defun pb/expand-file-specs (dir specs &optional subdir) (defun pb/expand-file-specs (dir specs &optional subdir)
@ -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,10 +672,10 @@ 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))))
(defun pb/copy-file (file newname) (defun pb/copy-file (file newname)
"Copy FILE to NEWNAME and create parent directories for NEWNAME if they don't exist." "Copy FILE to NEWNAME and create parent directories for NEWNAME if they don't exist."
@ -892,9 +893,9 @@ 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)
(princ "\nSuccessfully Compiled All Packages\n") (princ "\nSuccessfully Compiled All Packages\n")
(princ "\nFailed to Build the Following Packages\n") (princ "\nFailed to Build the Following Packages\n")
@ -906,9 +907,9 @@ 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)
(pb/dump-archive-contents))) (pb/dump-archive-contents)))
@ -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: