* lisp/emacs-lisp/cl-macs.el (cl-defstruct): Don't add print-func.

* lisp/files.el: Require cl-lib.
(file-name-non-special): Replace case -> cl-case.
This commit is contained in:
Stefan Monnier 2012-06-13 16:52:25 -04:00
parent 16192a5711
commit 5a315f9ce9
3 changed files with 22 additions and 12 deletions

View file

@ -1,5 +1,10 @@
2012-06-13 Stefan Monnier <monnier@iro.umontreal.ca>
* files.el: Require cl-lib.
(file-name-non-special): Replace case -> cl-case.
* emacs-lisp/cl-macs.el (cl-defstruct): Don't add print-func.
* emacs-lisp/edebug.el (edebug-read-function): Remove old incorrect
mapping from #' to function*.

View file

@ -2731,14 +2731,17 @@ value, that slot cannot be set via `cl-setf'.
(if (cl--safe-expr-p `(progn ,@(mapcar #'cl-second descs)))
(push (cons name t) side-eff))))
(if print-auto (nconc print-func (list '(princ ")" cl-s) t)))
(if print-func
(push `(push
;; The auto-generated function does not pay attention to
;; the depth argument cl-n.
(lambda (cl-x cl-s ,(if print-auto '_cl-n 'cl-n))
(and ,pred-form ,print-func))
cl-custom-print-functions)
forms))
;; Don't bother adding to cl-custom-print-functions since it's not used
;; by anything anyway!
;;(if print-func
;; (push `(if (boundp 'cl-custom-print-functions)
;; (push
;; ;; The auto-generated function does not pay attention to
;; ;; the depth argument cl-n.
;; (lambda (cl-x cl-s ,(if print-auto '_cl-n 'cl-n))
;; (and ,pred-form ,print-func))
;; cl-custom-print-functions))
;; forms))
(push `(setq ,tag-symbol (list ',tag)) forms)
(push `(cl-eval-when (compile load eval)
(put ',name 'cl-struct-slots ',descs)

View file

@ -28,6 +28,8 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
(defvar font-lock-keywords)
(defgroup backup nil
@ -6459,20 +6461,20 @@ only these files will be asked to be saved."
"/"
(substring (car pair) 2)))))
(setq file-arg-indices (cdr file-arg-indices))))
(case method
(cl-case method
(identity (car arguments))
(add (concat "/:" (apply operation arguments)))
(insert-file-contents
(let ((visit (nth 1 arguments)))
(prog1
(apply operation arguments)
(apply operation arguments)
(when (and visit buffer-file-name)
(setq buffer-file-name (concat "/:" buffer-file-name))))))
(unquote-then-quote
(let ((buffer-file-name (substring buffer-file-name 2)))
(apply operation arguments)))
(t
(apply operation arguments)))))
(t
(apply operation arguments)))))
;; Symbolic modes and read-file-modes.