-;;; cl-macs.el --- Common Lisp macros -*- lexical-binding: t; coding: utf-8 -*-
+;;; cl-macs.el --- Common Lisp macros -*- lexical-binding: t -*-
-;; Copyright (C) 1993, 2001-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2016 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Old-Version: 2.02
(if (stringp (car header)) (pop header))
;; Be careful with make-symbol and (back)quote,
;; see bug#12884.
- (let ((print-gensym nil) (print-quoted t))
- (format "%S" (cons 'fn (cl--make-usage-args
- orig-args)))))
+ (help--docstring-quote
+ (let ((print-gensym nil) (print-quoted t)
+ (print-escape-newlines t))
+ (format "%S" (cons 'fn (cl--make-usage-args
+ orig-args))))))
header)))
;; FIXME: we'd want to choose an arg name for the &rest param
;; and pass that as `expr' to cl--do-arglist, but that ends up
macroexpand-all-environment))))
(if (or (null (cdar bindings)) (cl-cddar bindings))
(macroexp--warn-and-return
- (format "Malformed `cl-symbol-macrolet' binding: %S"
- (car bindings))
+ (format-message "Malformed `cl-symbol-macrolet' binding: %S"
+ (car bindings))
expansion)
expansion)))
(fset 'macroexpand previous-macroexpand))))))
(let ((accessor (intern (format "%s%s" conc-name slot))))
(push slot slots)
(push (nth 1 desc) defaults)
+ ;; The arg "cl-x" is referenced by name in eg pred-form
+ ;; and pred-check, so changing it is not straightforward.
(push `(cl-defsubst ,accessor (cl-x)
+ ,(format "Access slot \"%s\" of `%s' struct CL-X."
+ slot struct)
(declare (side-effect-free t))
,@(and pred-check
(list `(or ,pred-check
slots defaults)))
(push `(cl-defsubst ,cname
(&cl-defs (nil ,@descs) ,@args)
- ,(if (stringp doc) (list doc)
+ ,(if (stringp doc) doc
(format "Constructor for objects of type `%s'." name))
,@(if (cl--safe-expr-p `(progn ,@(mapcar #'cl-second descs)))
'((declare (side-effect-free t))))
;;;###autoload
(pcase-defmacro cl-struct (type &rest fields)
"Pcase patterns to match cl-structs.
-Elements of FIELDS can be of the form (NAME UPAT) in which case the contents of
-field NAME is matched against UPAT, or they can be of the form NAME which
+Elements of FIELDS can be of the form (NAME PAT) in which case the contents of
+field NAME is matched against PAT, or they can be of the form NAME which
is a shorthand for (NAME NAME)."
- (declare (debug (sexp &rest [&or (sexp pcase-UPAT) sexp])))
+ (declare (debug (sexp &rest [&or (sexp pcase-PAT) sexp])))
`(and (pred (pcase--flip cl-typep ',type))
,@(mapcar
(lambda (field)
(defun cl-struct-sequence-type (struct-type)
"Return the sequence used to build STRUCT-TYPE.
-STRUCT-TYPE is a symbol naming a struct type. Return 'vector or
-'list, or nil if STRUCT-TYPE is not a struct type. "
+STRUCT-TYPE is a symbol naming a struct type. Return `vector' or
+`list', or nil if STRUCT-TYPE is not a struct type. "
(declare (side-effect-free t) (pure t))
(cl--struct-class-type (cl--struct-get-class struct-type)))
(put 'real 'cl-deftype-satisfies #'numberp)
(put 'fixnum 'cl-deftype-satisfies #'integerp)
(put 'base-char 'cl-deftype-satisfies #'characterp)
-(put 'character 'cl-deftype-satisfies #'integerp)
+(put 'character 'cl-deftype-satisfies #'natnump)
;;;###autoload