-;;; cl-macs.el --- Common Lisp macros -*-byte-compile-dynamic: t;-*-
+;;; cl-macs.el --- Common Lisp macros
-;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
;; Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
-(or (memq 'cl-19 features)
- (error "Tried to load `cl-macs' before `cl'!"))
-
+(require 'cl)
(defmacro cl-pop2 (place)
(list 'prog1 (list 'car (list 'cdr place))
(defvar cl-old-bc-file-form nil)
-;;;###autoload
-(defun cl-compile-time-init ()
- (run-hooks 'cl-hack-bytecomp-hook))
-
-
;;; Some predicates for analyzing Lisp forms. These are used by various
;;; macro expanders to optimize the results in certain common cases.
(let ((func (list 'function*
(list 'lambda (cadr x)
(list* 'block (car x) (cddr x))))))
- (if (and (cl-compiling-file)
- (boundp 'byte-compile-function-environment))
- (push (cons (car x) (eval func))
- byte-compile-function-environment))
+ (when (cl-compiling-file)
+ ;; Bug#411. It would be nice to fix this.
+ (and (get (car x) 'byte-compile)
+ (error "Byte-compiling a redefinition of `%s' \
+will not work - use `labels' instead" (symbol-name (car x))))
+ ;; FIXME This affects the rest of the file, when it
+ ;; should be restricted to the flet body.
+ (and (boundp 'byte-compile-function-environment)
+ (push (cons (car x) (eval func))
+ byte-compile-function-environment)))
(list (list 'symbol-function (list 'quote (car x))) func))))
bindings)
body))
;;;###autoload
(defmacro lexical-let* (bindings &rest body)
"Like `let*', but lexically scoped.
-The main visible difference is that lambdas inside BODY will create
-lexical closures as in Common Lisp.
+The main visible difference is that lambdas inside BODY, and in
+successive bindings within BINDINGS, will create lexical closures
+as in Common Lisp. This is similar to the behavior of `let*' in
+Common Lisp.
\n(fn VARLIST BODY)"
(if (null bindings) (cons 'progn body)
(setq bindings (reverse bindings))
byte-compile-delete-errors (nth 1 safety)))))
((and (eq (car-safe spec) 'warn) (boundp 'byte-compile-warnings))
- (if (eq byte-compile-warnings t)
- (setq byte-compile-warnings byte-compile-warning-types))
(while (setq spec (cdr spec))
(if (consp (car spec))
(if (eq (cadar spec) 0)
- (setq byte-compile-warnings
- (delq (caar spec) byte-compile-warnings))
- (setq byte-compile-warnings
- (adjoin (caar spec) byte-compile-warnings)))))))
+ (byte-compile-disable-warning (caar spec))
+ (byte-compile-enable-warning (caar spec)))))))
nil)
;;; Process any proclamations made before cl-macs was loaded.
(defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v))
\(fn NAME [FUNC | ARGLIST (STORE) BODY...])"
- (if (listp arg1)
+ (if (and (listp arg1) (consp args))
(let* ((largs nil) (largsr nil)
(temps nil) (tempsr nil)
(restarg nil) (rest-temps nil)
(defsetf frame-parameters modify-frame-parameters t)
(defsetf frame-visible-p cl-set-frame-visible-p)
(defsetf frame-width set-screen-width t)
-(defsetf frame-parameter set-frame-parameter)
+(defsetf frame-parameter set-frame-parameter t)
(defsetf getenv setenv t)
(defsetf get-register set-register)
(defsetf global-key-binding global-set-key)
method
(error "Setf-method for %s returns malformed method"
func)))
- (and (save-match-data
- (string-match "\\`c[ad][ad][ad]?[ad]?r\\'" name))
+ (and (string-match-p "\\`c[ad][ad][ad]?[ad]?r\\'" name)
(get-setf-method (compiler-macroexpand place)))
(and (eq func 'edebug-after)
(get-setf-method (nth (1- (length place)) place)
omitted, a default message listing FORM itself is used."
(and (or (not (cl-compiling-file))
(< cl-optimize-speed 3) (= cl-optimize-safety 3))
- (let ((sargs (and show-args (delq nil (mapcar
- (function
- (lambda (x)
- (and (not (cl-const-expr-p x))
- x))) (cdr form))))))
+ (let ((sargs (and show-args
+ (delq nil (mapcar
+ (lambda (x)
+ (unless (cl-const-expr-p x)
+ x))
+ (cdr form))))))
(list 'progn
(list 'or form
(if string
(list* 'list (list 'quote form) sargs))))
nil))))
-;;;###autoload
-(defmacro ignore-errors (&rest body)
- "Execute BODY; if an error occurs, return nil.
-Otherwise, return result of last form in BODY."
- `(condition-case nil (progn ,@body) (error nil)))
-
-
;;; Compiler macros.
;;;###autoload
(run-hooks 'cl-macs-load-hook)
;; Local variables:
-;; byte-compile-warnings: (redefine callargs free-vars unresolved obsolete noruntime)
+;; byte-compile-dynamic: t
+;; byte-compile-warnings: (not cl-functions)
;; generated-autoload-file: "cl-loaddefs.el"
;; End: