New special form `handler-bind`

AFAIK, this provides the same semantics as Common Lisp's `handler-bind`,
modulo the differences about how error objects and conditions are
represented.

* lisp/subr.el (handler-bind): New macro.

* src/eval.c (pop_handler): New function.
(Fhandler_Bind_1): New function.
(signal_or_quit): Handle new handlertypes `HANDLER` and `SKIP_CONDITIONS`.
(find_handler_clause): Simplify.
(syms_of_eval): Defsubr `Fhandler_bind_1`.

* doc/lispref/control.texi (Handling Errors): Add `handler-bind`.

* test/src/eval-tests.el (eval-tests--handler-bind): New test.

* lisp/emacs-lisp/lisp-mode.el (lisp-font-lock-keywords):
Move 'handler-bind' from CL-only to generic Lisp.
(handler-bind): Remove indentation setting, it now lives in the macro
definition.

1 files changed, 37 insertions, 0 deletions

diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el
index e4b18ec7849..9ac117859dd 100644
--- a/test/src/eval-tests.el
+++ b/test/src/eval-tests.el
@@ -303,4 +303,41 @@ expressions works for identifiers starting with period."
       (should (eq 'bar (default-value 'eval-tests/buffer-local-var)))
       (should (eq 'bar eval-tests/buffer-local-var)))))
 
+(ert-deftest eval-tests--handler-bind ()
+  ;; A `handler-bind' has no effect if no error is signaled.
+  (should (equal (catch 'tag
+                   (handler-bind ((error (lambda (_err) (throw 'tag 'wow))))
+                     'noerror))
+                 'noerror))
+  ;; The handler is called from within the dynamic extent where the
+  ;; error is signaled, unlike `condition-case'.
+  (should (equal (catch 'tag
+                   (handler-bind ((error (lambda (_err) (throw 'tag 'err))))
+                     (list 'inner-catch
+                           (catch 'tag
+                             (user-error "hello")))))
+                 '(inner-catch err)))
+  ;; But inner condition handlers are temporarily muted.
+  (should (equal (condition-case nil
+                     (handler-bind
+                         ((error (lambda (_err)
+                                   (signal 'wrong-type-argument nil))))
+                       (list 'result
+                             (condition-case nil
+                                 (user-error "hello")
+                               (wrong-type-argument 'inner-handler))))
+                   (wrong-type-argument 'wrong-type-argument))
+                 'wrong-type-argument))
+  ;; Handlers do not apply to the code run within the handlers.
+  (should (equal (condition-case nil
+                     (handler-bind
+                         ((error (lambda (_err)
+                                   (signal 'wrong-type-argument nil)))
+                          (wrong-type-argument
+                           (lambda (_err) (user-error "wrong-type-argument"))))
+                       (user-error "hello"))
+                   (wrong-type-argument 'wrong-type-argument)
+                   (error 'plain-error))
+                 'wrong-type-argument)))
+
 ;;; eval-tests.el ends here