[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/oclosure 9aa72cce6b: (oclosure-define): Add `:predicate`
From: |
Stefan Monnier |
Subject: |
scratch/oclosure 9aa72cce6b: (oclosure-define): Add `:predicate` |
Date: |
Fri, 28 Jan 2022 13:40:25 -0500 (EST) |
branch: scratch/oclosure
commit 9aa72cce6b041d57ef0a02c63130e8fb5662ad49
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
(oclosure-define): Add `:predicate`
* lisp/files.el (save-some-buffers): Use the defined predicate instead
of `cl-typep` so we don't need to load `cl-lib`.
* lisp/emacs-lisp/oclosure.el (oclosure--merge-classes):
Improve error message.
(oclosure-define): Add `:predicate` and fix `:mixin` handling.
(oclosure--define): Add support for `:predicate`.
(oclosure-lambda): Improve error message.
(save-some-buffers-function): Use `:predicate`.
---
lisp/emacs-lisp/oclosure.el | 20 +++++++++++++-------
lisp/files.el | 6 ++----
2 files changed, 15 insertions(+), 11 deletions(-)
diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el
index 9e0024a6c7..c53182fccd 100644
--- a/lisp/emacs-lisp/oclosure.el
+++ b/lisp/emacs-lisp/oclosure.el
@@ -214,7 +214,9 @@
(defun oclosure--merge-classes (names)
(if (null (cdr names))
- (cl--find-class (or (car names) 'oclosure))
+ (let ((name (or (car names) 'oclosure)))
+ (or (cl--find-class name)
+ (error "Unknown class: %S" name)))
(let* ((total-slots '())
(name (vconcat names))
(pinned 0)
@@ -299,18 +301,19 @@
(push (cdr tmp) val)
(setq options (delq tmp options)))
(nreverse val))))))
-
+ (predicate (car (funcall get-opt :predicate)))
(parent-names (or (funcall get-opt :parent)
(funcall get-opt :include)))
(copiers (funcall get-opt :copier 'all))
- (mixin (funcall get-opt :mixin)))
+ (mixin (car (funcall get-opt :mixin))))
`(progn
,(when options (macroexp-warn-and-return
(format "Ignored options: %S" options)
nil))
(eval-and-compile
(oclosure--define ',name ,docstring ',parent-names ',slots
- :mixin ',mixin))
+ ,@(when mixin `(:mixin ',mixin))
+ ,@(when predicate `(:predicate ',predicate))))
(oclosure--define-functions ,name ,copiers))))
(defun oclosure--build-class (name docstring parent-names slots mixin)
@@ -401,7 +404,8 @@
(when type
(memq name (oclosure--class-allparents
(cl--find-class type)))))))
- (predname (intern (format "%s--internal-p" name))))
+ (predname (or (plist-get props :predicate)
+ (intern (format "%s--internal-p" name)))))
(setf (cl--find-class name) class)
(dolist (slot (oclosure--class-slots class))
(put (cl--slot-descriptor-name slot) 'slot-name t))
@@ -495,7 +499,8 @@ ARGS and BODY are the same as for `lambda'."
`(oclosure--anonymous-define
',(oclosure--anonymous-name types) ',types)))
(type (eval type-exp t))
- (class (cl--find-class type))
+ (class (or (cl--find-class type)
+ (error "Unknown class: %S" type)))
(slots (oclosure--class-slots class))
(mutables '())
(slotbinds (mapcar (lambda (slot)
@@ -676,7 +681,8 @@ ARGS and BODY are the same as for `lambda'."
;; Ideally, this should be in `files.el', but that file is loaded
;; before `oclosure.el'.
-(oclosure-define save-some-buffers-function)
+(oclosure-define (save-some-buffers-function
+ (:predicate save-some-buffers-function--p)))
(provide 'oclosure)
diff --git a/lisp/files.el b/lisp/files.el
index a7f3c1c086..593925f138 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -5845,12 +5845,10 @@ change the additional actions you can take on files."
(interactive "P")
(unless pred
(setq pred save-some-buffers-default-predicate))
- ;; Can't be required at top-level for bootstrap reasons.
- (eval-when-compile (require 'cl-lib))
;; Allow `pred' to be a function that returns a predicate
;; with lexical bindings in its original environment (bug#46374).
- (when (or (and (symbolp pred) (get pred 'save-some-buffers-function))
- (cl-typep pred 'save-some-buffers-function))
+ (when (or (and (symbolp pred) (get pred 'save-some-buffers-function)
+ (save-some-buffers-function--p pred)))
(let ((pred-fun (and (functionp pred) (funcall pred))))
(when (functionp pred-fun)
(setq pred pred-fun))))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- scratch/oclosure 9aa72cce6b: (oclosure-define): Add `:predicate`,
Stefan Monnier <=