1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-02 23:50:47 +02:00
guile/module/ice-9/hooks.scm
Andy Wingo f930af2737 Move implementation of hooks to Scheme module
* module/ice-9/hooks.scm: New file.
* am/bootstrap.am: Add new file.
* module/ice-9/deprecated.scm: Add trampolines to (ice-9 hooks).
* module/ice-9/scm-style-repl.scm:
* module/ice-9/session.scm:
* module/ice-9/top-repl.scm:
* module/scripts/scan-api.scm:
* guile-readline/ice-9/readline.scm:
* benchmark-suite/benchmark-suite/lib.scm:
* module/system/repl/command.scm:
* module/system/repl/common.scm:
* module/system/repl/debug.scm:
* module/system/repl/error-handling.scm:
* module/system/repl/hooks.scm:
* module/system/repl/reader.scm:
* module/system/repl/repl.scm:
* module/ice-9/history.scm:
* test-suite/tests/hooks.test: Use the new module.
* module/oop/goops.scm: Remove <hook> class definition.
* libguile/vm.c:
* libguile/init.c:
* libguile/Makefile.am:
* libguile.h: Remove hooks.h includes.
* libguile/hooks.c:
* libguile/hooks.h: Remove.
* libguile/deprecated.h:
* libguile/deprecated.c: Add deprecation shims for C API.
2025-06-16 13:11:28 +02:00

79 lines
2.6 KiB
Scheme
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; Copyright (C) 2025 Free Software Foundation, Inc.
;;;
;;; This library is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU Lesser General Public License as
;;; published by the Free Software Foundation, either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this program. If not, see
;;; <http://www.gnu.org/licenses/>.
;;; Commentary:
;;;
;;;
;;; Code:
(define-module (ice-9 hooks)
;; FIXME: #:export instead of #:replace when deprecated code is
;; removed.
#:replace (make-hook
hook?
hook-empty?
add-hook!
remove-hook!
reset-hook!
run-hook
hook->list))
(define <hook>
(make-record-type '<hook> '(procs)
(lambda (hook port) (print-hook hook port))))
(define %make-hook (record-constructor <hook>))
(define* (make-hook #:optional nargs)
"Create a hook containing an ordered list of procedures."
(%make-hook '()))
(define hook? (record-predicate <hook>))
(define hook-procs (record-accessor <hook> 'procs))
(define set-hook-procs! (record-modifier <hook> 'procs))
(define (hook-empty? hook)
"Return @code{#t} if @var{hook} is an empty hook, @code{#f} otherwise."
(null? (hook-procs hook)))
(define* (add-hook! hook proc #:optional _append? #:key (append? _append?))
"Add the procedure @var{proc} to the hook @var{hook}. The procedure is
added to the end if @var{append?} is true, otherwise it is added to the
front."
(let ((procs (delq! proc (hook-procs hook))))
(set-hook-procs! hook (if append?
(append procs (list proc))
(cons proc procs))))
(values))
(define (remove-hook! hook proc)
"Remove the procedure @var{proc} from the hook @var{hook}."
(set-hook-procs! hook (delq! proc (hook-procs hook)))
(values))
(define (reset-hook! hook)
"Remove all procedures from the hook @var{hook}."
(set-hook-procs! hook '())
(values))
(define (run-hook hook . args)
"Apply all procedures from the hook @var{hook} to the arguments
@var{args}. The order of the procedure application is first to last.
The return value of this procedure is not specified."
(for-each (lambda (proc) (apply proc args))
(hook-procs hook))
(values))