-
Notifications
You must be signed in to change notification settings - Fork 761
/
hooks.scm
88 lines (66 loc) · 2.45 KB
/
hooks.scm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
;;;
;;; Code to support emacs-inspired hooks.
;;;
;;;; This is not functional yet, but it should be close...
;;; Private
;; Central repository for all hooks -- so we can look them up later by name.
(define gnc:*hooks* '())
;;; Developers
(define (gnc:hook-define name description)
(let ((hook-data (vector name description '())))
(set! gnc:*hooks* (assoc-set! gnc:*hooks* name hook-data))
hook-data))
(define (gnc:hook-danglers-get hook)
(vector-ref hook 2))
(define (gnc:hook-danglers-set! hook danglers)
(vector-set! hook 2 danglers))
(define (gnc:hook-danglers->list hook)
(gnc:hook-danglers-get hook))
(define (gnc:hook-replace-danglers hook function-list)
(gnc:hook-danglers-set! hook function-list))
(define (gnc:hook-run-danglers hook . args)
(gnc:debug "Running functions on hook " (gnc:hook-name-get hook))
(for-each (lambda (dangler)
(if (gnc:debugging?)
(begin
(display " ") (display dangler) (newline)))
(apply dangler args))
(gnc:hook-danglers-get hook)))
;;; Public
(define (gnc:hook-lookup name)
(assoc-ref gnc:*hooks* name))
(define (gnc:hook-add-dangler hook function)
(let ((danglers (gnc:hook-danglers-get hook)))
(gnc:hook-danglers-set! hook (append danglers (list function)))))
(define (gnc:hook-remove-dangler hook function)
(let ((danglers (gnc:hook-danglers-get hook)))
(gnc:hook-danglers-set! hook (delq! function danglers))))
(define (gnc:hook-description-get hook)
(vector-ref hook 1))
(define (gnc:hook-name-get hook)
(vector-ref hook 0))
(define gnc:*startup-hook*
(gnc:hook-define
'startup-hook
"Functions to run at startup. Hook args: ()"))
(define gnc:*shutdown-hook*
(gnc:hook-define
'shutdown-hook
"Functions to run at guile shutdown. Hook args: ()"))
(define gnc:*ui-shutdown-hook*
(gnc:hook-define
'ui-shutdown-hook
"Functions to run at ui shutdown. Hook args: ()"))
(define gnc:*main-window-opened-hook*
(gnc:hook-define
'main-window-opened-hook
"Functions to run whenever the main window is opened. Hook args: (window)"))
;;(let ((hook (gnc:hook-lookup 'startup-hook)))
;; (display (gnc:hook-name-get hook))
;; (newline)
;; (display (gnc:hook-description-get hook))
;; (newline)
;; (gnc:hook-add-dangler hook (lambda ()
;; (display "Running a simple startup hook")
;; (newline)))
;; (gnc:hook-run-danglers hook))